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The 

RICIS 

Concept 


The University of Houston-Clear Lake established the Research Institute for 
Computing and Information systems in 1986 to encourage NASA Johnson Space 
Center and local industry to actively support research in the computing and 
information sciences. As part of this endeavor, UH-Clear Lake proposed a 
partnership with JSC to jointly define and manage an integrated program of research 
in advanced data processing technology needed for JSC’s main missions, including 
administrative, engineering and science responsibilities. JSC agreed and entered into 
a three-year cooperative agreement with UH-Clear Lake beginning in May, 1 986, to 
jointly plan and execute such research through RICIS. Additionally, under 
Cooperative Agreement NCC 9-16, computing and educational facilities are shared 
by the two institutions to conduct the research. 

The mission of RICIS is to conduct, coordinate and disseminate research on 
computing and information systems among researchers, sponsors and users from 
UH-Clear Lake, NAS A/ JSC, and other research organizations. Within UH-Clear 
Lake, the mission is being implemented through interdisciplinary involvement of 
faculty and students from each of the four schools: Business, Education, Human 
Sciences and Humanities, and Natural and Applied Sciences. 

Other research organizations are involved via the “gateway” concept. UH-Clear 
Lake establishes relationships with other universities and research organizations, 
having common research interests, to provide additional sources of expertise to 
conduct needed research. 

A major role of RICIS is to find the best match of sponsors, researchers and 
research objectives to advance knowledge in the computing and information 
sciences. Working jointly with NASA/JSC, RICIS advises on research needs, 
recommends principals for conducting the research, provides technical and 
administrative support to coordinate the research, and integrates technical results 
into the cooperative goals of UH-Clear Lake and NASA/ JSC. 
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1. Introduction 


Under subcontract to University of Houston - Clear Lake as part of the Cooperative Agreement between 
L HCL and NASA Johnson Space Center, Inference Corporation conducted an Ada-Based Expert System 
Building Tool Design Research Project. The goal of the research project was to investigate various issues 
in the context of the design of an Ada-based expert systems building tool The research project 
attempted to achieve a comprehensive understanding of the potential for embedding expert systems sn 
Ada systems, for eventual application in future projects. 

This report will describe the current status of the project by introducing an operational prototype, 
ART/Ada. It will then explain how the project was conducted analyze the performance of the prototype, 
compare it with other related works, and suggest future research directions. 
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2. Project Goal 

This chapter identifies the goal of the Ada-Based Expert System Building Tool Design Research Project 

This chapter is composed of three sections: 

• Conventional Expert System Tools 

• Considerations for Ada Environment 

• Requirements for the Real-Time Embedded Systems 

As the Department of Defense mandate to standardize on Ada as the language for embedded software 
systems development begins to be actively enforced, interest from developers of large-scale Ada systems in 
making expert systems technology readily available in Ada environments has increased. 

Two examples of Ada applications that can benefit from the use of expert systems are monitoring and 
control systems and decision support systems. Monitoring and control systems demand real-time 
performance, small execution images, tight integration with other applications, and limited demands on 
processor resources; decision support systems have somewhat less stringent requirements. An example 
project which exhibits the need for both of these types of systems is NASA’s Space Station Freedom 
Monitoring and control systems that will perform fault detection, isolation and reconfiguration for 
various on-board systems are expected to be developed and deployed on the station either in its initial 
operating configuration or as the station evolves; decision support systems that will provide assistance in 
activities such as crew-time scheduling and failure mode analysis are also under consideration These 
systems will be expected to run reliably on a standard data processor, currently envisioned as a 1-16 
megabyte 386-based workstation The Station is typical of the large Ada software development projects 
that will require expert systems in the 1990’s. 

2.1 Conventional Expert System Tools 

Inference Corporation developed an expert system tool called Automated Reasoning Tool (.ART) which 
has been commercially available for several years [8]. ART is written in Lisp and it supports various 
reasoning facilities such as rules, frames, truth maintenance, hypothetical reasoning, and object-oriented 
programming. 

More recently, Inference introduced another expert system tool called ART-IM (Automated Reasoning 
Tool for Information Management) which is also commercially available [9|. ART-IM is written in C and 
it supports a subset of ART’s reasoning facilities; ART-IM Version 1.5 supports forward-chaining rules, 
frames, truth maintenance, and basic object-oriented programming. 
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Both ART and ART-IM have been successfully used to develop many applications which are in daily use 
today. 


2.2 Considerations for Ada Environment 

This research project permitted Inference to study how to bring the ART and ART-IM features into 
Ada environments. Inference’s approach in designing an Ada-based expert system tool is to use an 
existing architecture such as .ART or ART-IM so that its input language would be identical to that of an 
existing tool. 

Two approaches to implementing the existing architecture were considered: 

1. To implement the whole system in Ada 

2. To implement an Ada deployment compiler as part of an existing tool 

Since the purpose of the project was to research operational issues such as those discussed below, it was 
decided to take approach number 2. 


2.3 Requirements for Real-Time Embedded Systems 

Laffey et. al. identified potential problems in using conventional expert system tools for real-time 
applications[Laffey88bJ . Many of these problems are already solved by ART and ART-IM. 

.ART and .ART-IM provide features for embedded environments such as 

• They have facilities for handling asynchronous inputs. 

• They have a standard call-in and call-out interface for various languages. 

• They assign priorities to rules which can be used to focus attention on important events 

• They have interrupt capabilities. 

• They can run continuously even if there is no rule to fire. 

Among the problems that Laffey et. al. identified, ART and ART-IM do not address the following 
problems: 

• Guaranteeing response times 

• Temporal reasoning capability 

Both .ART and .ART-IM are based on the Rete algorithm [5j. Laffey et. al. claim that in real-time 
applications, the knowledge base changes too rapidly for the Rete algorithm to be optimal [III. Barachini 
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et. al. claim that an expert system tool based on the Rete Algorithm can be optimized to better support 
real-time expert systems [2j. The reported speed of their system, however, does not seem much faster 
than that of other C-based tools such as CLIPS or ART-CM. Some tools specialized in the monitoring and 
analysis applications do not use the Rete algorithm; they use a compiled, static knowledge base in which 
all variables used in the rules are resolved at compile time 12; jiOi. While the speed of these tools seems 
faster than that of the Rete-based tools, these tools still cannot guarantee response times The main 
drawback is that they may not be suitable for expert system application areas other than monitoring and 
analysis. An alternative approach to the compiled, static knowledge base is an object-oriented 
programming (OOP) facility that uses active values. The OOP facility is already implemented in ART. 
and it is being considered for ART-IM and ART/Ada. 

A temporal reasoning capability refers to a way to invoke a rule at a regular time interval. For 
example, the following is a temporally driven rule: 

Check the price of IBM stocks every hour. 

If the price goes down more than five dollars in an hour, 
then sell all shares. 

The temporal reasoning capability can be directly supported, or it could be implemented as an Ada task 
outside of the inference engine. The task should be started during the initialization phase of the expert 
system as a demon that wakes up at a certain time interval. A built-in temporal reasoning capability, 
therefore, may not be as important as the issue of guaranteed response times. 

There are two different levels of real-time requirements: soft real-time and hard real-time 12b In a 
hard real-time system, the correctness of the system depends not only on the result of computation, but 
also on the time at which the results are produced. If these strict timing constraints are not met, the 
consequence may be disastrous. On the other hand, in a soft real-time system, disastrous consequences do 
not result if the dead-line is missed. While most expert system tools try to address the soft real-time issue 
today by improving their performance, they do not, yet, address the hard real-time issue. 

The current generation embedded processors such as the MIL-STD-1750A have limited addressing 
capability of 2 megabytes. Medium size Ada-based expert systems may not fit into this limitation. It is 
also known that the size of the Ada-based expert systems is larger than that of C-based counterparts. 
While next-generation embedded processors such as the 80386 would alleviate the size problem, it would 
still be desirable to study how to optimize the size of the Ada-based inference engine. 
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3. Current Status 

This chapter discusses the status of a prototype Ada-based expert system building tool, called .ART Ada 
Version 10. 


3.1 Overview 

A primary goal of this research phase was to design an expert system tool that allowed applications to 
be deployed in Ada environments. In order to achieve this goal, three components were needed: 

• Existing expert system tool as a baseline 

• Application generator that generates Ada code 

• Ada-based inference engine 

After ART and ART-IM were reviewed carefully, ART-IM was selected as a baseline system because C 
was much closer to Ada than Lisp. ART/Ada, an Ada-based inference engine, was modeled after that of 
.ART-IM Version 1.0 which supported forward chaining rules. 

.ART-IM has a deployment compiler that converts an application into C data structure definitions An 
Ada deployment compiler was designed using the C deployment compiler as a model. The Ada 
deployment compiler converts C data structures specific to an application into Ada source code that 
would be used to initialize Ada data structures equivalent to the original C data structures. The Ada 
deployment compiler is written in C and is part of .ART-IM. 

3.2 Introduction to ART-IM 

ART-IM is a general purpose expert system tool written in C. .ART-IM version 1.0 implements a 
forward-chaining rule-based inference engine using on the Rete algorithm. It also has a truth 

maintenance system, called Logical Dependency 

ART-IM version 1.5 includes a frame system, called Schema system, which is fully integrated with the 
rule system. It also includes an explanation system, called Justifications. In addition, ART-IM version 
1.5 for MS-DOS has a presentation manager style user interface, called Studio, that provides extensive 
capabilities for debugging ART-IM applications. An example of a Studio screen is shown in Figure 3-1. 

The .ART-IM syntax is basically a subset of the ART syntax. .An application written in ART. therefore, 
can be easily ported to .ART-IM. 
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Figure 3-1: Composite ART-IM Screen 
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3.3 ART-IM Ada Deployment Compiler 

ART-IM Version 1.5 was augmented with an Ada Deployment Compiler to support the .ART 'Ada run- 
time system. .As shown in figure 3-2, its input is an ART-IM source file, and its output is Ada source 
files. At any point after an .ART-IM source file is loaded into .ART-IM and reset, it can be invoked to 
generate the Ada source code that will be used to initialize .ART internal data structures for the 
.ART Ada runtime system. The .ART-IM program can be run up to any given point before the code 
generation takes place. 

Since it is part of .ART-IM, the Ada deployment compiler is written in C In addition to generating Ada 
source code that represents the knowledge base, it also generates a call-out interface module that can be 
used to call user-defined Ada functions. .ART-IM provides a powerful call-out specification language that 
can be used to call out from .ART-IM or from ART/ Ada to Ada. 



Figure 3-2: ART-IM Ada Deployment Compiler 
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3.4 ART/Ada Run-time System 

The ART/Ada run-time system is composed of the following components: 

• Inference engine 

• Procedural Interface Package 

• Memory management package 

• Ada deployment compiler utilities 

• User interface package 

ART/Ada’s inference engine is based on the Rete algorithm, and supports only forward chaining rules 
matching on facts as specified in the ART-Cvt Version 1.0 syntax. 

.ART/Ada supports a simplified version of the procedural language of ART-IM. ART/Ada's procedural 
interface can be used either in the rule right-hand side, or directly in user’s Ada programs. The 
procedural interface includes data type conversions between the Ada data types and the .ART data types, 
predicates, operations on ART objects, .ART commands, I/O functions, and math functions. .ART/Ada’s 
I/O system supports simple input and output functions. Unlike ART-IM, stream are not supported in 
.ART/Ada. All streams variables default to either standard output or input. File I/O is not supported in 
.ART/Ada. .ART/ Ada's math package provides most mathematical functions except trigonometric 
functions. 

.ART/Ada’s memory management package uses Ada the features new and unchecked _ deallocation 
to allocate and deallocate memory. In phase II, the advantages and disadvantages of implementing a 
memory manager for ART/Ada will be investigated. 

The .ART/Ada run-time system contains utilities called by the Ada code that ART-IM Ada deployment 
compiler generates. 

.ART/Ada has an optional simple command interface that support rudimentary debugging features such 
as tracing/untracing rules, facts, activations, printing out facts and agenda, and running the program 


3.5 Deployment in Ada Environment 

.As shown in Figure 3-3. the following steps are needed to deploy an ART-IM application in Ada: 

1. Develop an application in .ART-IM using ART-IM’s development environment. 

2 . If necessary, call out to Ada from ART-Cvt using the standard callout mechanism for both 
.ART-IM and .ART/Ada. 
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4. Prototype Development Process 

This chapter discusses how the ART Ada Version 1.0 prototype was developed. 


4.1 Specification 

ART-IM Version 1.0 was used as a functional specification for the ART, 'Ada Version 10 prototype. 
Some features in .ART-IM TO (e.g. Logical Dependency) that were not essential for the proof of concept 
were left out intentionally. 

The ART-IM C source code was used as a detailed design specification for the ART/Ada run-time 
system. The .ART-IM internal function definitions and data structures were converted to Ada package 
specifications which were compiled by an Ada compiler. The Ada package specification served as a 
detailed design specification of .ART/Ada. 


4.2 Object-Oriented Design 

.ART/Ada was designed using the object-oriented design (OOD) methodology. The object-oriented 
design is an approach to software design in which the system is decomposed into a set of objects. Each 
object is mapped to one or more Ada packages. Four different kinds of packages were used in the design: 

• Abstract Data Object (ADO) 

• Abstract Data Type (ADT) 

• Package of subroutines (SUB) 

• Package of declarations (DCL) 

The Abstract Data Object is a package that contains encapsulated data and operations (expressed as 
subprograms) performed upon those data. These data are static and local to that package Thev are 
known as state data. 

The Abstract Data Type is a package that contains abstract types and operations performed on those 
abstract types. The operations are expressed as subprograms and the abstract types are declared as the 

Ada types 

The package of subroutines is a package of logically related subroutines. There exists no encapsulated 
data in this package. 


The package of declarations is a package of logically related declarations. These declarations may be 
types, constants, or exceptions. 
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4.3 Implementation 

Once package specifications for the Ada run-time system were laid out. the packages were divided 
among two programmers to be implemented. Again, the ART-IM C source code was used as a program 
design language (PDL). Despite the differences between C and Ada, it was relatively easy to port C code 
into Ada. In fact, productivity was as high as 500 to 1000 lines of code a week per person during the 
actual coding phase. 

Perhaps it is worthwhile to describe the difficulties encountered while porting C to Ada. A lack of 
function pointers in Ada made it necessary to write a case statement which contains all the Ada 
subprograms that were called either by the system or by the user. This case statement was generated 
automatically by the Ada deployment compiler according to the call-out interface specification of system 
functions and user-defined functions. 

In C, it is legal to treat an arbitrary memory location as a certain data type at run-time through type 
casting. For example, four bytes of memory could be used as a long integer or as a pointer depending on 
how it is casted. Similarly, a pointer to a data type can be casted to a pointer to another data type. 
.Another example is bit manipulation operations such as bitwise exclusive OR which is useful in hashing. 
Ada does not allow such practices in general. Certainly they are not recommended if they are not 
prohibited. Since ART-IM uses many such C features to achieve the maximum efficiency, it was 
unavoidable to sacrifice some performance when it was ported to Ada. 


4.4 Reuse 


In order to reduce the development cost of the .ART/ Ada prototype, it was decided in the early phase of 
the project that the Booch components [4.1 would be used in the ART/ Ada prototype A linked-list 
package, a string package, and other utility packages are used by ART/Ada. The following is the full 
list: 

• “vcalenut.a* - package CALENDAR _ UTILITIES 

• “ vcharuti.a" - package CHARACTER _ UTILITIES 

• "vfixedut.a" - generic package FIXED _ POINT _ UTILITIES 

• "vfloatut.a" - generic package FLOATING _ POINT _ UTILITIES 

• “vintegrt.a" - generic package INTEGER _ UTILITIES 

• " vlistsum.a" - generic package LIST _ SINGLE _ UNBOUNDED _ MANAGED 

• “vstorage.a" - generic package STORAGE _ MANAGER _SEQUENTLAL 
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• "vstrings.a" ” generic 

STRING _ SEQUENTIAL _ UNBOUNDED _ MANAGED _ ITERATOR 

• "vstringt.a" — package STRING _ UTILITIES 


package 


Some of these packages had to be modified because they failed to compile on a certain compiler, or their 
functionality was not what was desired. The modified version of these components were successfully 
compiled on Alsys, Verdix, and DEC compilers. The package body of 

LIST SINGLE _ UNBOUNDED _ MANAGED did not compile on the Sun Tartan compiler because of a 
bug in the compiler. Consequently, the Tartan compiler had to be excluded in the benchmark 


4.5 Testing 

It was difficult to unit-test ART/ Ada modules which were part of the inference engine kernel because 
these modules were highly interdependent. For example, it was impossible to test the join network 
module without the pattern network module. For this reason, test programs originally developed for 
ART-IM were modified and used to validate ART/ Ad a functionally as well as to do some unit testing. 
This validation and verification method turned out to be very effective. It is analogous to the Ada 
compiler validation test suite. 

In the future, if an independent third party verification and validation contractor develops a set of test 
suites for a particular expert system tool, it would be an effective way to validate an expert system tool 
such as .ART /Ada. It does not seem feasible to develop a general purpose test suite for several expert 
system tools because the input languages are usually very different. It may be possible to come up with a 
set of general requirements for developing such a test suite, though. 


4.6 Debugging 

In VLSI testing, a "golden device" that has been proven correct in advance is used to test chips in 
production. Likewise, ART-IM served as "golden software" while testing and debugging ART/Ada. 

Many times, a source-level C debugger on a Sun, dbxtool, was used side by side with the Verdix Ada 
debugger to track down subtle bugs, which was very effective. While single-stepping through critical code 
segments, difficult bugs were easily isolated. 
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4.7 Summary 

It was a great advantage to have a commercial expert system tool. ART-IM. and its source code 
throughout the development cycle of the ART/Ada prototype. Dunn? all phases of prototype 
development, it helped programmers greatly. As a result, it allowed high productivity among 
programmers and high quality in the prototype It also reduced the development time greatly Without 
it, it would have been impossible to develop an operational prototype in such a short time. With two 
programmers working on the project, coding was started in July 1988. and the prototype was fully 
operational in December 1988. A modified version of Boehm's sp.ral model ;3j is used to show the 
-ART/Ada 1.0 prototype life cycle in Figure 4-1. 


Maintenance* 

Documentation 


Faaaibillty 
(Apr-June *88) 


Vertflcation/Validation 
(Dec ’88) 


Preliminary Design 
(July ( 88) 



Detailed Design 
(Aug *88) 


I - Proof-of-Concept Prototype 


Figure 4-1: Spiral Life Cycle of the .ART/Ada 1.0 prototype 
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5. Performance Analysis 

This chapter analyzes the performance of the ART Ada 10 prototype. 

The following programs were used to benchmark it. In both programs, 10 was suppressed so that the 

speed measured was not the speed of I/O, but that of the .ART Ada inference engine. 

• Monkey and Banana: It fires 81 rules, and it has 13 facts in the knowledge base after it runs 

• N-Queens (6 Queens): It fires 515 rules, and it has 155 facts in the knowledge base after it 

runs. 

ART /Ada code was successfully compiled on the following platforms: 

• IBM PS/2 Model 70 using the Alsys 286 DOS Ada compiler Version 4.2 

• Sun 3/260 using the Verdix Sun Ada compiler Version 5.5K. 

• Sun 3/260 using the .Alsys Sun Ada compiler Version 4.2 Beta 

• VAXstation II using the DEC Ada compiler Version 1.5 

As mentioned earlier, the package body of a Booch component, 
LIST SINGLE _ UNBOUNDED _ MANAGED, did not compile on the Tartan Sun Ada compiler Version 
2.0 because of a bug in the compiler. Consequently, the Tartan compiler was excluded in the benchmark 

Ada files were compiled with maximum suppression of error checks and maximum optimization. For 
the Verdix Sun Ada compiler, the following command was used: 

a . make -S -0 -v main -f * a. 

For the Alsys compilers, the following default was used for compilation: 

COMPILE (OPTIONS => (CHECKS => STACK) . 

IMPROVE => (CALLS = > INLINED , 

REDUCTION => EXTENSIVE) 

KEEP => (DEBUG => NO, 

COPY => NO) ) ; 

In addition, the following default was used on the Alsys 286 DOS compiler for linking. 

BIND PROGRAM=MAIN , EXECUTION= EXTEND ED 
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5.1 Speed 

The speed of ART/ Ada is measured on the following platforms: 

1. Sun 3/260 with 16 MBytes of memory using the Verdix Ada compiler 

2. Sun 3/260 with 16 MBytes of memory using the Aisys Ada compiler 

3. IBM PS/2 Model 70 386 20 MHz with 6 MBytes of memory using the Aisys Ada compiler 

The speed is measured in the number of rules per second against a wall-clock time, not a CPU time 
The PS/2 is a single user system. The Sun was connected to the network and was being used as a file 
server occasionally, but no other program was running while benchmark programs were running. 

Here it should be noted that ART/ Ada on a PS/2 uses different table sizes. A direct comparison, 
therefore, between the speed of ART/ Ada on a Sun ant that on a PS/2 is not possible. 


Platform 

Monkey 

6 Queens 

Sun/Verdix 

38.2 Rules/ Sec 

42.7 Rules/Sec 

Sun /Aisys 

46.4 Rules/Sec 

62.4 Rules/Sec 

PS/2 /Aisys 

37.4 Rules/Sec 

49.9 Rules/Sec 


Table 5-1: Speed of .ART/ Ada in Rules/ Second 


5.2 Size 

The size of ART/Ada is measured on the following platforms: 

1. Sun 3/260 with 16 MBytes of memory using the Verdix Ada compiler 

2. Sun 3/260 with 16 MBytes of memory using the Aisys Ada compiler 

Since multiprocessing is not supported in MS-DOS, size of the .ART/ Ada process could not be measured 
On a Sun workstation, size of the ART/Ada process was measured in KBytes using a Unix command, "ps 
aux", after the program finished running and just before it was exited. 


Platform 

Monkey 

6 Queens 

Sun/Verdix 

968 KBytes 

1232 KBytes 

Sun/Alsys 

768 KBytes 

944 KBytes 


Table 5-2: Size of .ART/Ada in KBytes 
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5.3 Discussion 

The benchmark results reported should be considered as preliminary results because of the following 

reasons: 

• No effort was made to optimize the performance of the ART/Ada prototype due to the time 
limitation. 

• More compilers should be included in the benchmark. 

• More hardware platforms should be included in the benchmark. 

• Better monitoring tools are necessary. One problem with Ada is that it does not support CPL 
time; it only supports wall-clock time. Therefore, the benchmark result is subject to many 
variables such as the load on the system, network activities, etc. 

The size limitation of current generation embedded processors such as the MEL-STD-1750A is L 
megaword (2 megabytes) within which all software systems including the operating system have to run. 
This might be too restrictive for medium size expert systems. New generation embedded processors such 
as the 80386 would be adequate for many expert systems developed using an Ada-based expert system 

tool such as .ART/Ada. The speed of the ART/Ada prototype seems comparable to other tools, especially 

* 

C-based tools, although it is slower. 

It is interesting that both speed and size of ART/Ada vary significantly depending on which Ada 
compiler is used. It is known that Ada compilers are not very efficient 6]. .As the Ada compiler 
technology advances, the .ART/Ada performance would be improved. 


*The unoptimized ART/Ada prototype is about 2*3 times slower in execution speed and about 2-3 times larger in process size than 
ART-IM 


16 


ART /ADA DESIGN PROJECT - PHASE I 


FINAL REPORT 


6. Related Work 


This chapter compares the ART/ Ad a prototype with other similar systems such as 

• CLIPS Ada T 

• PAMELA :2; 

• FLAC [10] 

• L*STAR [12] 

CLIPS (C Language Production System) is a C-based forward-chaining rule-based expert system tool 
whose syntax is very close to .ART and ART-IM. It has been reported that CLIPS is being ported to Ada. 
Unlike ART/ Ada, the whole system is being reimplemented in Ada. CLIPS does not have a frame 
system, a truth maintenance system, and an explanation system. Its only knowledge representation 
method is a forward-chaining rule system. 

It is claimed that PAMELA (PAttern Matching Expert system LAnguage) uses the Rete algorithm 
improved with optimizations and extensions that could satisfy the requirements of many real-time 
applications. Unlike ART/Ada, PAMELA does not seem to support deployment in Ada environments. It 
is implemented in CHILL(Communication High Level Language). PAMELA is similar to .ART Ada 
because it is based on the Rete algorithm. In addition to PAMELA, other optimizations on the Rete 
algorithm have been proposed and implemented by Gupta [7] Schor et. al. [ 14] and Miranker ;13|. 

FLAC (Ford Lisp-Ada Connection) uses a Lisp environment to develop an expert system application, 
and generates Ada code to be deployed in Ada environments [10]. Its knowledge base is specified using a 
graphical representation similar to that of VLSI design (e g. OR gates and AND gates), which gets 
compiled into a static knowledge base. Because of this compiled, static knowledge base, high performance 
of 1500 rules per second on a VAX 11/780 was achieved, perhaps, at the cost of flexibility. It still does 
not guarantee response times. 

FLAC is similar to ART/Ada because its development environment is not implemented in Ada, but the 
Ada deployment is supported. The difference is, however, that FLAC’s development env ironment is based 
on Lisp, while ART/Ada uses that of ART-EM which is written in C. The C and Ada development 
environments coexist on the same hardware platforms more often than the Lisp and Ada development 
environments do. FLAC, for example, uses a special purpose Lisp machine for the front-end, and a VAX 
for the Ada deployment. Both ART-IM and ART/Ada run on the same hardware. Another difference is 
that FLAC’s input is graphically oriented while .ART/Ada is language-oriented. FLAC’s pre-compiled, 
static knowledge base imposes restrictions on the reasoning capability which do not exist in the inference 
engines based on the Rete algorithm such as ART-IM and .ART/Ada. 
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L*STAR (Lockheed Satellite Telemetry Analysis in Real time) is designed for real-time monitoring and 
analysis expert systems. L*STAR has a built-in feature for temporal reasoning. All data is archived and 
time-tagged into a ring buffer. The ring buffer consists of a compressed format which keeps track of the 
last time the datum was updated and each time it changed over a user-specified time period. ART Ada 
does not support temporal reasoning It could be implemented, however, using .ART Adas asynchronous 
function capability. An asynchronous function is an Ada procedure that gets invoked between rule 
firings. It can be implemented to achieve the same behavior as L*STAR’s temporal reasoning facility. 

Unlike ART/Ada and PAMELA, L*STAR is not based on the Rete algorithm. In L*STAR. not all the 
rules are continually checked. Some of the rules are triggered by the test clock at regular time intervals. 
Other rules are checked only when data changes that is used in one of its IF clauses, or when they are 
needed to achieve a goal. Rules are compiled into an intermediate postfix format or optionally into 
C. Because all variables are resolved at compile time, multiple variables in a single rule can result in a 

combinatoric increase in the number of rules generated. In this sense, it is similar to FLAC. While it 

achieves the performance of about 1000 rules per second on a VAX 8650, L*STAR still cannot guarantee 
response times. Although it seems to work well for the real-time monitoring and analysis applications, it 
is unclear whether this 'architecture would satisfy the requirements of other expert system application 
areas besides the monitoring and analysis applications. L*STAR is written in C, and does not support 
deployment in Ada environments. 

Tools like FLAC and L*STAR seem to achieve high performance because they have a static knowledge 
base in which variables are resolved at the compile time. It might be possible to achieve the same level of 
performance if object-oriented programming (OOP) facilities such as active values are used to invoke 
actions from objects which represent those variables. When the active value capability is added to ART- 

IM and .ART/Ada, the performance of the OOP methodology could be compared to that of the static 

knowledge base. 
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7. Future Work 

This chapter suggests the future directions for the Ada-Based Expert System Building Tool Design 
Research Project. 

The current prototype system supports only forward-chaining rules There are multiple knowledge 
representation techniques one or more of which are usually used for a particular application To support 
various application, an expert system tool should support more than one paradigm. It would be useful, 
therefore, to enhance the ART/Ada prototype with a frame system, a truth maintenance system, and a 
explanation system which exist in ART-EM 1.5. This enhanced prototype will be called .ART Ada 1 5 
ART-[M will be still used as a development environment and as an Ada deployment compiler. A 
modified version of Boehm's spiral model [3j is used to show the proposed .ART/Ada 1.5 prototype life 
cycle in Figure 7-1. 


Maintenance* 

. Documentation 


Feasibility 
(Feb '89) 



Preliminary Design 
(March '89) 


Varfflcatlon/ValldatJon 
(Sep '89) 


Detailed Design 
(March *89) 


I - Proof-of-Concept Prototype 
H - Expanded Proof-of-Concept Prototype 


Figure 7-1: Proposed Spiral Life Cycle of the ART/Ada 1.5 prototype 

Once the .ART Ada 15 prototype is completed, significant effort should be dedicated to understand the 
operational issues and potential uses of the prototype. This may involve a joint effort with potential 

users who use the .ART/Ada 1.5 prototype to implement prototype expert systems for the Space Station 
F reedom. 
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Additional research effort would be necessary to enhance .ART Ada 1.5 to better support the real-time 
embedded applications. The following issues need be investigated further: 

• To meet the soft and hard real-time requirements, 

• To support the distributed environments such as parallel processors 

• To fit into the embedded processors. 

It is feasible to reimplement all of ART-IM in Ada including the front-end and the development 
environment. The following modules would be required. 

• Front-end: a lexer, a parser, a semantic analyzer, a code generator, etc. 

• User interface: a graphical debugging tool and debugging-oriented functions to browse various 
knowledge base objects 

• New Ada deployment compiler written in Ada 

• Miscellaneous: the Clear and Reset commands, an error handling system, etc. 

It would not be easy to reimplement ART-IM’s development environment in Ada because most graphics 
packages are written in C. An Ada binding would have to be used to interface ART/Ada with existing 
C-based graphics packages. Despite standardization efforts such as X windows, graphics applications are 
not very portable today. It might be necessary, therefore, that the multiple graphics packages (e g. X 
Windows and Presentation Manager) be supported. Integration and testing would also require significant 
effort. 

7.1 Summary 

In summary, the following projects are recommended as future projects: 

• To implement the .ART/Ada 1.5 prototype (compatible with .ART-IM 1.5) 

• To study the operational issues and potential uses of the ART/Ada 1.5 prototype 

• To enhance the current architecture to better support real-time applications 

. To implement the whole ART/Ada 1.5 in Ada including the development environment and 
integrate it with an existing APSE (Ada Programming Support Environment) 
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8. Conclusion 


As shown in the preliminary benchmark results of the operational prototype, this project succeeded in 
proving that the conventional expert system tool could be used to deploy its applications m Ada 
environments with efficient use of time and space. 

Another important goal of this project was to reuse existing software. During the prototype 
development, software reuse techniques were practiced at all levels. 

• A commercially available software component library, the Booch Components, was used to 
implement data structures. 

• A commercial software system, ART-EM, was reused for various purposes: as a functional 

specification and a detailed design of the ART/Ada run-time system; as a development 
environment for .ART/Ada applications; and as an Ada deployment compiler. 

• The .ART-EM test programs were also reused to test the whole Ada deployment process; to 
debug the ART-IM Ada deployment compiler and the ART/Ada run-time system. 

The reuse practice of the project, especially the reuse of .ART-EM, contributed greatly to the high 
productivity in coding, testing, and integration and the high quality of the .ART/Ada prototype. During 
the coding phase, productivity was as high as 1000 lines of code a week per person, and was in average 
about 500 lines of code a week per person. Thanks to the .ART-EM test programs, it took only about a 
month to fully validate the prototype. Testing and integration would have taken much longer if no test 
programs had been available. The source listings of the test programs are available in the appendix. 


21 



ART/ ADA DESIGN PROJECT ■ PHASE I 


FINAL REPORT 


References 


1. Artificial Intelligence Section, NASA Johnson Space Center. CLIPS Version \.2 Reference Manual 
NASA Johnson Space Center, 1988. 

2. Barachini, F., Theuretzbacher, N. The Challenge of Real-time Process Control for Production 
Systems Proceedings of the National Conference on .Artificial Intelligence, .AAAI, 1988, 

3. Boehm, B.W, "A Spiral Model of Software Development and Enhancement". Computer 21. 5 (May 

1988) . 

4. Booch, G. Software Components With Ada. Benjamin/Cummings Publishing, 1987. 

5. Forgy, C.L. "RETE: A Fast Agorithm for the Many Pattern / Many Object Pattern Match 
Problem" Artificial Intelligence 19(1982). 

8. Ganapathi, M. t Mendal, G.O. "Issues in Ada Compiler Technology". Computer 22, 2 (February 

1989) . 

7. Gupta, A. Parallelism in Production Systems. Pitman Publishing, 1988. 

8. Inference Corporation. A RT Version 3.2 Reference Manual. Inference Corporation, 1988. 

9. Inference Corporation. A RT-IM 1.5 Reference Manual. Inference Corporation, 1988. 

10. Jaworski, A., LaVallee, D., Zoch, D. A Lisp-Ada Connection for Expert System Development. 
Proceedings of the third Annual Conference on Artificial Intelligence and Ada, 1987. 

11. Laffey, T.J., Cox, P.A., Schmidt, J.L., Kao, S.M., Read, J.Y. "Real-Time Knowledge-Based 
Systems". A I Magazine 9, 1 (Spring 1988). 

12. Laffey, T, S. Weitzenkamp, Read, J., Kao, S., Schmidt, J. Intelligent Real-Time Monitoring 
Proceedings of the National Conference on Artificial Intelligence, .AAAI, 1988. 

13. Miranker, D.P. TREAT: A Better Match Agorithm for A1 Production Systems. Proceedings of the 
National Conference on Artificial Intelligence, AAAI, 1987. 

14. Schor, M.I., Daly, T.P., Lee, H.S., Tibbitts, B.R. Advances in Rete Pattern Matching. Proceedings 
of the National Conference on Atificial Intelligence, .AAAI, 1988 


oo 



ART/ADA DESIGN PROJECT - PHASE I 


FINAL REPORT 


I. Detailed Description of ART/Ada 
Implementation 

In this chapter, the ART Ada prototype will be described in greater detail. 


I.l Deploying an ART-IM application in Ada 

The following steps are necessary to deploy an ART-IM application in an Ada environment: 

1. Load an application into , ART-IM. This can be achieved either through the .ART-IM Studio 
menus or by entering a command. When the menu is used, select File, Load and an 
appropriate filename. When a command is used, enter 

(load *<f ilename*' - ) 

“• Reset the application. This can be achieved either through the Studio menus or by entering a 
command. When the menu is used, select Run and then Reset. When a command is used, 
enter 


(reset) 

3. Generate Ada code for the application. This can be achieved either through the Studio menus 
or by entering a command. When the menu is used, select File and then Ada Generate 
When a command is used, enter 


(load ■ bu 1 ldada . art") ; load call-out definitions 

(set-generate-options 1000 25 ) ; set generate options 

(generate-ada "<f ilenarne-pref ix>") , generate Ada code 


The menu command Ada Generate executes the first two commands automatically. The file 
buildada.art contains Ada call-out definitions used by ART/Ada internally. If there exists 
users Ada code to be called from ART/Ada, the call-out interface should be defined either in 
this file or in a separate file, and loaded into ART-IM. The function, set-generate-options, 
sets maximum number of source lines per Ada source file and maximum number of source 
lines per Ada subprogram. For example, (set-generate-options 1000 25) set the maximum lines 
per file to 1000, and the maximum number of lines per subprogram to 25. These numbers 
were found optimal for some Ada compilers. .ART-IM will generate multiple files: 

• funcall.a — procedure FUNCALL for calling out to Ada 


• < filename-prefix > . a — specification and body of a package, < filename-prefix > 


• < filename-prefix >1. a, < filename-prefix > 2. a, ... — separate procedures contained in 
the package, < filename-prefix > 

• < filename-prefix > .com. — a command file to compile Ada source files. 

4. Compile the Ada source files using an Ada compiler using < filename-prefix > com which 
might have to be customized for each compiler. So far, only Alsys compiler has been used on 
a PS/2. 
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5. Write the main program. A simple command loop may or may not be included in the main 
program. 

6 Link the Ada executable image. 

7. Run the Ada executable image. 

1.1.1 Ada Source Code Generated by the Ada Deployment Compiler 

The generated Ada code includes a procedure called INIT which initializes an application in the 
.ART Ada knowledge base. 

Below is the package specification generated by the Ada Generator for an application, MAB: 


package MAB is 
procedure INIT; 
end MAB; 

with GEN_UTIL_ADO , GLQBAL_DCL ; 
package body MAB is 

procedure MABO -is separate, 
procedure MAB1 is separate; 
procedure MAB2 is separate; 
procedure MAB3 is separate; 
procedure MA94 is separate; 
procedure MAB5 is separate; 
procedure MAB6 is separate, 

procedure INIT is 
begin 

GEN_UTIL_ADO . INIT_INIT ; 
MAB1 ; 

MAB2 ; 

MAB3 ; 

MAB4 ; 

MAB5 ; 

MAB6; 

GEN_UTIL_ADO ,CRDSS_REF ; 
MABO, 

GEN_UTIL_ADO . CLEANUP ; 
GEN_UTIL~ADO . SYSTEM_INIT ; 
end INIT, 

end MAB; 


In addition to generating a package specification for an application, the Ada deployment compiler also 
generates the separate procedure body for INTERPRETER_SUB.FUNCALL. This procedure is the top- 
level procedure called by the function call interpreter to cail out to Ada subprograms. These Ada 
subprograms consist of those used internally by ART/Ada and those defined by the user. All user-defined 
Ada subprograms should be defined in the package USER_SUB. 
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1.1.2 ART/Ada User Interface Command Loop 

A simple command loop is included in the ART/Ada run-time system It supports a minimum subset of 
the .ART- EM command syntax which is necessary for simple tracing and debugging. The following syntax 
is supported: 


<art cmd> 

: : = (<command>) 


<command> 

::= <trace_cmd> 1 cuntrace cmd> 

<agenda_cmd> | <facts cmd> 

l <run cmd> 

1 <exit cmd> 

cuntrace cmd> 

::= untrace cuntrace arg> 


cuntrace arg> 

: := rules I facts I activations I 

all 

ctrace cmd> 

: : - trace ctrace arg> 


<trace arg> 

: := cuntrace_arg> | status 


<run cmd> 

: := run | run <lnteger> 


<agenda cmd> 

: := agenda 


<facts cmd> 

: : = f acts 


<exit cmd> 

: := exit 



1.1.3 Example Main Programs 

Two examples of the .ART/Ada main programs are included in this section: one that includes the 
command loop, and one that does not. .Although the main program should be defined by the user for 
each application because the name of the package that contains the application specific procedures varies, 
it would be easy to modify the standard one. 

The following is an example of the main program that includes the user interface by calling 

COMMAND LOOP: 
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with USER_ I NTERF ACE_SUB , ERROR_HDL_SUB , MAB; 

procedure MAIN is 

begin 

MAB. INIT; 

USER_INTERFACE_SUB . C0MMAND_L00P ; 
exception 

when CCNSTRAINT_ERRQR => 

ERROR_HDL_SUB . PR0CESS_ERR0R (ERR0R_HDL_SUB . CONSTRAI NT_ERR) . 
when PR0GRAM_ERR0R => 

ERR0R_HDL SUB PR0CESS_ERR0R (ERROR_HDL_SUB . PROGRAM_ERR) ; 
when STORAGE_ERROR => 

ERROR_HDL_SUB . PROCESS_ERRGR(ERROR_HDL__SUB . ST0RAGE_ERR) ; 
when TASKING_ERROR => 

ERROR_HDL_SUB . PR0CESS_ERR0R (ERROR_HDL_SUB . TASKING_ERR) ; 
when ERROR_HDL_SUB . TIME_ERROR => 

ERROR_HDL_SUB . PRDCESS_ERRQR (ERROR_HDL_SUB . TIME_ERR) ; 
when ERROR_HDL_SUB . INTERNAL_ERROR => 

ERROR HDL_SUB . PROCESS_ERROR (ERROR_HDL_SUB . INTERNAL_ERR) ; 
when ERROR HDL_SUB . RETRACT_ERROR => 

ERROR_HDL_SUB PR0CESS_ERR0R (ERROR_HDL_SUB . RETRACT_ERR) ; 
when ERROR_HDL_SUB. INTERPRETER_ERROR => 

ERROR HDL SUB . PROCESS_ERROR (ERROR_HDL_SUB . INTERPRETER_ERR) > 
when ERROR HDL_SUB . US£R_ERR0R => 

ERR0R_HDL_SUB . PROCESS_ERROR (ERROR_HDL_SUB . USER_ERR) ; 
when ERROR_HDL_SUB.USER_DEFINED_ERRQR => 

ERROR_HDL_SUB . PR0CESS_ERR0R (ERROR_HDL_SUB . USER_DEFINED_ERR) . 
end MAIN; 


This main program initializes an expert system application called MAB, and prompts the user for a 
command. The USER _ INTERFACE package is with’ed to gain access to the COMMAND _ LOOP 
procedure. 

The following is an example of the main program that is tailored for an embedded application: 
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with ART, ERROR_HDL_SUB, MAB; 

procedure MAIN is 

begin 

MAB . INIT ; 

ART RUN (-1) ; 
exception 

when CGNSTRAINT_ERROR => 

ERRGR_HDL_SUB PROCESS^ERROR (ERROR_HDL_SUB . CONSTRAINT_ERR) . 
when PR0CRAM_ERR0R => 

ERROR_HDL_SUB PROCESS_ERROR (ERROR_HDL_SUB . PROGRAM_ERR) ; 
when STORAGE ERROR = > 

ERROR_HDL_SUB PRCCESS_ERROR (ERROR_HDL_SUB . STORAGE_ERR) ; 
when TASKING^ERROR => 

ERROR__HDL_ilJB PROCESS^ERROR (ERROR_HDL_SUB . TASKING_ERR) ; 
when ERRQR_HDL_SUB . TIME_ERROR ~=> 

ERROR_HDL_SUB . PR0CESS_ERR0R (ERROR_HDL_SUB . TIME_ERR) ; 
when ERRGR_HDL_SUB . INTERNAL_ERROR ~=> 

ERRQR_HDL_SUB PR0CESS_ERR0R (ERROR_HDL_SUB . INTERNAL_ERR) ; 
when ERROR_HDL_SUB . RETRACT_ERROR "=> 

ERRQR_HDL_SUB . PR0CESS_ERR0R (ERROR__HDL_SUB . RETRACT_ERR) ; 
when ERROR_HDL_SUB. INTERPRETER_ERRQR => 

ERRQR_HDL_SUB . PR0CESS_£RR0R (ERROR_HDL_SUB . INTERPRETER_ERR) ; 
when ERROR_HDL_SUB . USER_ERRQR => 

ERROR_HDL_SUE) . PROCESS _ERR0R (ERROR_HDL_SUB . USER ERR) ; 
when ERROR_HDL_SUB . USER_DEFINED_ERROR => 

ERROR_HDL_SUB PR0CESS_ERR0R (ERROR HDL_SUB.USER DEFINED ERR); 
end MAIN; 


This main program initializes and runs an expert system application, called MAB The 
USER __ INTERFACE package is not with’ed by the main program. 


1.2 Public Packages in ART/Ada 

The ART/Ada runtime system is composed of public Ada packages and internal Ada packages. The 
following is a list of public packages that can be with’ed and, in some cases, modified by the user: 

• ART 

• ERROR _HDL_ SUB 

• USER _ INTERFACE _ SUB 

1.2.1 ART 

The package, ART, contains public subprograms to be used to call into .ART/Ada from user’s Ada 
program. This package should be with ed by the user program whenever subprograms in this package are 
called. The .ART package contains the following; 

• Data types: Integer _ Type, Natural _ Type, Positive_Type, Float__Type, ART _ Object 

• Type conversions: ART _ Symbol, ART_String, ART_Integer, .ART _ Float, Ada_Symbol, 
Ada_String, Ada_ Integer, Ada _ Float 

• Predicates: Symbolp, Stringp, Integerp, Floatp, Numberp, Sequencep, Factp 
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• Operations: Eq, Equal, Type_of. Gentemp. Length, Position, Member, Nth, Set_Nth, 

Find Fact, Fact_Number, Register_ ART_Object, l T nregister_ART_Object, 

Make _ Template, Free_Template, Sequence 

• \RT commands: .Assert, Retract. Run. Halt, Get_Async_Fun, Set_ Async _Fun. 

Get Salience _ Threshold, Set _ Salience _ Threshold, Get_ Limit _ Default, 

Set _ Limit _ Default, Get _ Print _ Messages, Set _ Print _ Messages 

• I/O Functions: Print, Prinl, Princ, Read 

In ART/' Ad a, all integer numbers are INTEGER_TYPE which is a 32 bit integer, and all float 
numbers are FLOAT _ TYPE which is a 64 bit float. ART_Object is a generic data type which could be 
one of the following: integer, float, string, symbol, fact, or sequence. 


Data type conversion functions are provided to convert .ART data types to Ada data types or to convert 
Ada data types to ART data types. 

Predicate functions are similar to Lisp predicates. They return T or NIL depending on the result of the 
predicate. 

The ART package provides various operations on ART _ Object. 

The .ART package also includes ART-IM commands such as Run and Halt as well as functions to change 
the defaults of ART/Ada. 

Simple I/O functions are provided to handle basic input and output. File I/O is not supported. 


1.2.2 ERROR _HDL_ SUB 

The package. ERROR _HDL_ SUB, contains subprograms for error handling. It contain two separate 
procedures, PROCESS _ ERROR and WARNING, that can be modified to customize the behavior of the 
error handler. For example, the default behavior is to print the error or warning messages on the screen 
It could be changed, however, to print it on the line printer m an embedded environment. This package 
also defines exceptions one of which is USER _ DEFINED _ ERROR. It is a generic exception that can be 
raised by the user. 

1.2.3 USER _ INTERFACE _ SUB 

The package, USER _ INTERFACE _SUB, contains a simple user interface that can be invoked by a 
procedure, COMMAND _ LOOP It also include debugging functions such as FACTS, AGENDA, and 
TIMED _ RUN It is not necessary to with this package when the presence of the user interface is not 
needed (i.e. embedded applications). 
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1.3 Ada Call-In and Call-Out Specification for ART/Ada and 
ART-IM 

This section describes a portable call-in/call-out interface specification for ART Ada and ART-IM. 

1.3.1 Interface Types 

The following types may be passed between ART and Ada: 

INTEGER ( I NTEGER_TYPE) This type is an 32 bit integer in Ada and an integer in ART 
(INTEGER _ TYPE in ART/Ada and long in ART-IM). 

:BOOLEAN (BOOLEAN) In .ART, this type is either NIL or non-NTL. In Ada, this type is 
BOOLEAN which is TRUE or FALSE. When translating from Ada to .ART, TRUE 
will translate to T. 

:FLOAT (FLOAT^TYPE) In Ada, this type is FLOAT_TYPE which is double precision float 

For .ART-IM, this is a C double. 

:STRING (STRING) In Ada, this type is represented as a STRING. In .ART, this type is 

represented as an .ART string. .ART may or may not copy the string being passed by 
this mechanism when passing a string from .ART to Ada. Thus, it is an error to 
destructively modify a string passed with this mechanism. .ART is responsible for 
freeing any space necessary for the string after exiting the current scope The actual 
implementation will be based upon constraints of the underlying architecture When 
transferring a string from Ada to .ART, .ART will always copy the string, allowing the 
Ada programmer to free the string at his leisure. 

:SYMBOL (STRING) In Ada, this type is represented as a STRING In .ART, this type is a 

symbol. Case is preserved when interning an STRING as an .ART symbol, just as case 
is preserved when passing a string to the Lisp function INTERN. 

:ART-OBJECT (ART_OBJECT) This type is any .ART type in .ART. It is represented as a pointer to a 
discriminant record in .ART/Ada. For ART-IM, it is an integer type which represents 
a C pointer to a C structure art_object. A set of Ada functions is provided to operate 
on these .ART objects from Ada. 

1.3.2 Scope of Objects 

This section gives a detailed description of the scope of objects communicated from .ART to Ada and 
objects communicated from Ada to ART. In both cases the prime motivation for scoping is that the 
caller should free all objects it allocates, (thus it should not allocate objects which it intends that the 
callee free). Additionally, the callee should not destructively modify objects which it did not allocate. 

All objects that are not immediate fall under these constraints. For example, strings and art-objects 
passed from .ART to Ada conform to the following semantics. 
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When an ART OBJECT or string is passed from ART by call out to an Ada function, the object is 
automatically reclaimed when the Ada function returns to .ART. At this point, the Ada ART_OBJECT 
data structure is no longer valid for use in Ada code. It is an error to retain a pointer to an 
automatically reclaimed ART_QB JECT in Ada once the Ada call has returned. 

When an ART OBJECT or string is returned from AJRT to Ada. it is automatically reclaimed when 
control returns to .ART from Ada. In those implementations where Ada can start up and call .ART as a 
subroutine so that a returned value may never be reclaimed, the returned ART_OBJECT is allocated 
permanently and must be freed using a freeing function supplied in Ada. 

A function is supplied in Ada that accepts an ARTJDBJECT as argument and returns a permanent copy 
of that ART OBJECT. This object must be explicitly freed when no longer useful. 


1.3.3 Call-Out from ART to Ada 

The following is a grammar for def-user-fun which should used to call out to Ada from .ART: 

(def -user- fun <f un-name > {<comment>> 

<f unction-spec>*) 

<f unction-spec> : : = 

: compiler <compiler-name> I 

; returns <return-data-type> I 
epname <link-editor-symbol> I 
args (<arg-spec>*) 

<fun-name> : := <art-symbol> 

<comment> ::= <art-string> 

<compiler-name> : := 

: VERDIX-ADA 
: DEC-ADA 
ALSYS-ADA 

<mternal-data-type> : : = 

: SYMBOL 
STRING 
: FLOAT 
: INTEGER 
: BOOLEAN 
ART-OBJECT 

<return-data-type> : : = 

VOID I < internal -data- type > 

<link-editor-symbol> : := 

<art-symbol> i <art-string> 
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<arg-spec> : := 

(<name> <internal-data-type> <arg-attribute>*) [ 
(< internal -data- type> <arg-attribute>*) I 
< internal -data- type> 

<name> :.= <art-symbol> 

<arg-attribute> := 

<convention> I 
<status> 

<convention> : : = 

: OBJECT-POINTER | 

: VALUE-POINTER | 

: VALUE 


<status> : := 

<optional> I 

<rest> 

<optional> : := 

: optional I 

( : optional <def ault>) 

<default> : := art-object 

<rest> ::= :rest ; Must be the last arg 


For example, in order to call out to an Ada function, CALC_STD _ DEV, using an .ART function. 

calc-std-dev, define the following in ART-CVt before the Ada code is generated: 

(def -user-fun calc-std-dev 

: epname " CALC_STD_DEV M 

: args ((sx float) (ssq : float) (n : integer)) 

: returns : float 
: compiler : alsys-ada) 


An Ada package called USER _ SUB should be also defined as follows: 
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with ART , MATH_LIB . TEXT_IQ . 
use ART,TEXT_IO, 
package USER_SUB is 

type REAL_TYPE is digits 15; 

package MY_MATH_LIB is new MATH_LIB (REALJTYPE) ; 
use MY_MATH_LIB , 

function CALC_STD_DEV (SX FLOATJTYPE; 

SSQ ■ FLOAT_TYPE ; 

N INTEGER_TYPE) return FLOATJTYPE; 

end USER_SUB ; 

package body 'JSER_SUB is 

function CALC_STD_DEV(SX . FLOATJTYPE; 

SSQ : FLQAT_TYPE ; 

N INTEGERJTYPE) return FLOATJTYPE is 

SD: FLOATJTYPE; 
begin 

SD := (SSQ - ((SX * SX) /FLOAT_TYPE(N) ) ) / FLCATJTYPE(N - 1); 
return FLQAT_TYPE(MY_KATH_LIB . SQRT (REAL_TYPE(SD) ) ) ; 
end CALC_STD_DEV ; 

end USER SUB; 


1.3.4 Call-In from Ada to ART/ Ada 

The ART package of ART/Ada is the public package for the ART/Ada users to call in from Ada to 
ART/Ada. The specification of the .ART package will serve as the standard Ada call-in interface 
specification. 
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II. Difference between ART-IM 1.5 and 
ART /Ada 1.0 

Among the ART-IM 1.5 features that are missing in .ART Ada, the following features will he 
implemented in phase II: 

• Schema System - a frame system 

• Logical Dependency - a truth maintenance system 

• Justification System - an explanation system 

The following features were not implemented during the phase I due to time limitation, but will be 
implemented during phase II. 

• some string functions 

• some I/O functions 

• some math functions 

• procedural iterators 

• asynchronous function 

The following features are not planned to be supported in ART/Ada: 

• streams 

• external data interface functions (e.g. def-external-data, def-map-fun, etc.) which are useful 
for building database interfaces. 

• Trigonometric functions (e.g. sin, cos, etc) which are not part of standard Ada. 
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COPYRIGHT NOTICE 

1) COPYRIGHT (C) 1988 
INFERENCE CORPORATION, 

5300 V . Century Blvd . , 

Los Angeles, California 90045 
AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED. 

2) Restricted Rights Notice (Short Form) (April 1984) 

Use, reproduction, or disclosure is 
subject to restrictions set forth in 
Government Cooperative Agreement Number NCC- 
9-16 between the National Aeronautics and 
Space Administration and the University of 
Houston-Clear Lake and a subcontract 
thereunder, Number 015 between the University 
of Houston-Clear Lake and Inference 
Corporation . 

3) Restricted Rights Notice (ART/Ada) 

These data constitute Inference 
Corporation trade secrets and/or information 
that is commercial or financial and 
confidential or privileged. They are 
submitted to the Government under NASA 
Cooperative Agreement NCC-9-16 with the 
University of Houston-Clear Lake Research 
Institute for Computing and Information 
Systems (RICIS) with the understanding that 
they will not, without the permission of 
Inference Corporation, be used or disclosed 
for other than evaluation purposes. 


-- Author: S. Daniel Lee 

-- Package : ART 

-- Function: This package contains subprograms for the user to call into 
ART/Ada. This package is the top-level public package which 
contains all the operations on ART/Ada. This package should 
always be with'ed in the user’s program 

-- State Variables: 

None 

-- State Variable Initialization: 

None 

— Change Log: 


with STRUCT_DCL, ART_DB JECT_SUB , DATABASE_SUB , I NFER _ENG_SUB , CALLI0_SUB, 
ALLQC_SUB . IQ_SUB , AGENDA_SUB , 
use STRUCT_DCL , 
package ART is 


-- Public Types for Ada Callout 
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subtype INTEGER_TYPE 

is 

STRUCT_ 

_DCL. INTEGER TYPE, 

■- For 

: INTEGER 

-- Use BOOLEAN 




-- For 

BOOLEAN 

subtype FLOAT^TYPE 

is 

STRUCT 

^DCL . FLOAT TYPE. 

-- For 

: FLOAT 

-- Use STRING 




-- For 

: STRING 

subtype ART_CB JECT 

is 

STRUCT^ 

DCL . ART_QB JECT ; 

-- For 

ART-OBJECT 

subtype NATURAL_TYPE 

is 

STRUCT 

DCL.NATURAL_TYPE; 



subtype PQS ITIVE_7YPE 

is 

struct] 

DCL . POSITIVE_TYPE . 




-- Operations on AST objects 


Returns a nev. permanent art_object reference to the ART object 
-- referred to by reference. Reference may be either a permanent 
-- or automatically allocated art_object. 


function REGISTER_ART_OB JECT (REFERENCE ART_08JECT) return ART_OBJECT 

renames ART_OBJECT_SUB . REGISTER_ART OBJECT; 


Frees the permanent or temporary reference to an art_object; 
it is an error to continue to use an art_object after freeing the 
-- reference to it. 


procedure UNREGlSTER_ART_OB JECT (REFERENCE : ART OBJECT) 
renames ART_0B JECT_SUB . UNREGISTER_ART OBJECT? 


Returns TRUE if the two art_obJects X and Y are the same object 
-- EQ and EQUAL are equivalent 


function EQ(X: ART_QBJECT ; 

Y: ART_08JECT) return BOOLEAN 
renames ART_0 B JECT SUB. EQ; 


Returns TRUE if the two art_objects X and Y are the same object. 
-- EQ and EQUAL are equivalent. 


function EQUAL (X : ART_0B JECT ; 

Y: ART_OBJECT) return BOOLEAN 
renames ART_0BJECT_SU8 EQUAL. 


Returns the type of an object, as a symbol. 


function TYPE_0F(0BJ: ART_OBJECT) return ART_QB JECT 
renames ART_0B JECT_SUB . TYPE OF; 


A_GENTEMP : Creates a nev, previously 
-- unused symbol . 


function GENTEMP (STR STRING) return ART_08 JECT 
renames ART_OBJECT_SUB . GENTEMP ; 


Calls the Ada procedure PROCESS once for each permanent OBJECT 
that has been allocated passing each permanent art object 
as the argument to PROCESS in turn. If PROCESS returns FALSE 
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-- at any time, then the iteration is terminated at that point. 


-- generic 

-- with procedure PROCESS (TH£_ITEM : in ART_OBJECT; 

CONTINUE : out BOOLEAN); 

-- procedure F0R_ALL_PER_ART_0B JECTS ; 


-- Returns an ART_0BJECT for the symbol resulting from performing a 
— intern operation on the string str Case is presered in str. 


function ART_SYMBOL(STR : STRING) return ART_OBJECT 
renames ART OB JECT_SUB . ART_SYMBOL ; 


-- Returns an ARTJOBJECT that represents the string specified. 
-- Case is preserved . 

function ART STRING (STR STRING) return ARTJOBJECT 
renames ART OB JECT_SUB . ART_STRING; 


-- Returns an ART OBJECT that represents the number specified. 


function ART INTEGER (NUM: INTEGER_TYPE) return ART_QBJECT 
renames ART OB JECT_SUB . ART_INTEGER ; 


-- Returns an ARTJOBJECT that represents the number specified. 


function ART_FL0AT (NUM ; FLOAT_TYPE) return ARTJOBJECT 
renames ART OBJECT SUB ART_FL0AT ; 


— Returns a STRING that is the print name of the symbol. 


function ADA_SYMBOL (SYMBOL; ART_OBJECT) return STRING 
renames ART OBJECT SUB. ADA SYMBOL; 


-- Returns a STRING that represents the ART_OBJECT specified. 


function ADAjSTRING (STR : ART_QBJECT) return STRING 
renames ART OBJECT SUB . ADA_STRING , 


-- Returns the number represented by the ARTjQBJECT specified. 


function AD A_ INTEGER (NUM: ARTjOBJECT) return INTEGER_TYPE 
renames ART OBJECT SUB . AD A_ INTEGER, 


— Returns the number represented by the ARTJOBJECT specified. 


function ADA_FL0AT (NUM : ART_OBJECT) return FLOAT_TYPE 
renames ART OBJECT SUB . ADA_FL0AT ; 


-- Predicates 


-- Returns TRUE if the ART_OBJECT, OBJ. is a. symbol, otherwise FALSE 
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function SYMBQLP(OBJ: ART_OBJECT) return BOOLEAN 
renames ART_C8JECT_SUB . SYMBOLP ; 


-- Returns TRUE if the ART_CBJECT, OBJ, is a string, otherwise FALSE 


function STRINGP(OBJ; ARTJDBJECT) return 300LEAN 
renames ART_0B JECT SUB STRINGP; 


Returns TRUE if the ART_OBJECT. OBJ, is an integer, otherwise FALSE 


function INTEGERP(GBJ : ART_GBJECT) return BOOLEAN 
renames ART_OBJECT SUB . INTEGERP; 


-- Returns TRUE if the ARTJDBJECT, OBJ, is a float, otherwise FALSE. 


function FLOATPCOBJ: ART_08 JECT) return BOOLEAN 
renames ART_CBJECT SUB . FLQATP ; 


Returns TRUE if the ART_QBJECT, OBJ, is a number, otherwise FALSE. 


function NUMBERP (OBJ : ART_QBJECT) return BOOLEAN 
renames ART_CB JECT_SUB . NUMBERP ; 


Returns TRUE if the ART_OBJECT, OBJ, is a sequence, otherwise FALSE. 


function SEQUENCE? (OBJ : ARTJ3BJECT) return BOOLEAN 
renames ART_0BJECT_SU8 . SEQUENCER; 


" Returns TRUE if the ART_0B JECT . OBJ, is a fact, otherwise FALSE 


function FACTP(GBJ: ART_0B JECT) return BOOLEAN 
renames ARTJDBJECT SUB FACTP, 


■“ Fact and Sequence Manipulation 


Returns the fact with fact number n. If no fact has that number, 
— returns NULL. 


function FIND_FACT (N : INTEGER_TYPE) return ARTJ3BJECT 
renames DATABASE_SUB . FIND FACT; 


INT_FIND_FACT : Finds a fact based on a ID, and returns NIL instead of NULL. 


function INT_FIND_FACT(ID : INTEGER_TYPE) return ARTjDBJECT 
renames DATABASE_SUB . INT_FIND FACT, 


Returns the fact number of fact. 


function FACT_NUMBER (FACT : ARTJDBJECT) return NATURAL JTYPE 
renames DATABASE_SUB FACT NUMBER; 


FQR_ALL_FACTS : Iterates over all the facts ia the current database, calling a given 
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— procedure once for each fact. 

-- generic 

with procedure PROCESS (THE_ITEM in ARTJ3BJECT; 

CONTINUE : out BOOLEAN); 

-- procedure FGR_ALL_FACTS ; 


-- Returns length of obj . 


function LENGTH (OBJ : ART_0B JECT) return NATURAL_TYPE 
renames ART OB JECT_SUB LENGTH ; 


— Returns the position of the first occurrence of value in obj. If 

— value is not in obj, returns 0 

function POSITION (VALUE : ART_OBJECT; 

OBJ: ART_Q8 JECT) return NATURALJTYPE 
renames ART_C8JECT_SUB . POSITION ; 


-- Returns TRUE if value is in obj, and FALSE otherwise 


function MEMBER (VALUE: ART_OBJECT, 

OBJ: ART JDB JECT) return BOOLEAN 
renames ART OBJECT_SUB MEMBER ; 


-- Returns the nth element of obj . 


function NTH (OBJ: ART_OBJECT ; 

INDEX; NATURALJTYPE) return ART_0B JECT 
renames ART _0B JECT _SUB . NTH ; 


— Fact and Sequence Creation 


-- Constructs an "empty - fact template and returns a pointer to it as an 
— ART object which may later be asserted. It is an error to assert a 
-- template without inserting something into each of the size slots 
-- allocated in it. All templates are permanent. Additionally they should 
-- not be freed with nnregister_art_ob j ect They should only be freed 
-- with f ree_template 

function MAKEJTEMPLATE(SIZE: NATURALJTYPE) return TEMPLATE JTYPE 
renames CALL 10 SUB . MAKE JTEMPLATE , 


-- This function sets the element of template specified by 

— index to be value. It is an error to attempt to modify a fact 

— not created with MAKEJTEMPLATE . The first element of the fact (the 

— relation) is indexed by index 1 The other elements of the fact 
-- nave indices 2 through the length of the fact 


procedure SET_NTH (TEMPLATE : In out T EMP LATE _ TYPE, 
INDEX: in INTEGER JTYPE, 

VALUE: in ART_0B JECT) 
renames CALLIO SUB.SET_NTH; 


-- Frees the TEMPLATE JTYPE template It is an error to continue to refer to 
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template after freeing. 


procedure FREE_TEMPLATE( TEMPLATE: in out TEMPLATE_TYPE) 
renames CALLIO_SUB . FRE£_TEMPLATE , 


Asserts a fact from the contents of template into the ART database 
““ Template must be constructed using the functions and macros below 

prior to assertion. It is an error to assert a fact with an empty fact 
-- slot. A template may be used for any number of assertions. 


function ASSERT (TEMPLATE: in TEMPLATE_TYPE) return ART_GB JECT 
renames CALLIO SUB ASSERT, 


This function takes a template and returns a sequence matching the 
teiplate. The sequence returned will not incorporate or alter the 
— template. 


function SEQUENCE (TEMPLATE : in TEMPLATE_TYPE) return ART_OBJECT 
renames CALLIO_SUB . SEQUENCE ; 


— ART Control 


-- Retracts fact from the ART database 


procedure RETRACT (FACT in out ART_0B JECT) 
renames DATABASE_SUB RETRACT, 


Function: Runs the inference engine (match-select-act cycle) LIMIT 
number of times. Continue to run until the agenda is 
ercpty, until the HALT is encountered on the rhs of a rule, 
until a salience threshold is reached, or until a breakpoint 
is triggered. 

Parameters: LIMIT - Number of inference engine cycles. (Or number of rules 
allowed to fire. 

> 0 fire that many rules 

= 0 then No rules fire 

= “1 then LIMIT := current default limit 

<= ~2 fire until agenda becomes empty 

function RUN (RUN_LIMIT : in INTEGER_TYPE) return INTEGERJTYPE 
renames INFER_ENG_SUB . RUN , 


-- Returns TRUE if the agenda is empty. Otherwise, FALSE. 


function AGENDA_EMPTY_P return BOOLEAN 
renames AGENDA SUB. AGENDA EMPTY P; 


-- Function: Complete the execution of all rhs actions of the current 
rule and halts the inference engine. 


procedure HALT 

renames INFER_ENG SUB. HALT; 
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— Function: It sets the asynchronous Ada function. 

The asynchronous function should be defined in the USER_SUB 
package . ART/Ada will Intern this function and assign it 
a function ID. 

procedure SET_ASYNCH_FUN (FUN : STRING) 
renames INFER ENG_SUB . SET_ASYNCH_FUN ; 


-- Function: It returns the name of the asynchronous Ada function. 


function GET_ASYNCH_FUN return STRING 
renames INFER ENG_SUB GET_ASYNCH_FUN ; 


-- Returns the minimum salience below which rules may not fire 

function GET_SALIENCE_THRESHOLD return SALIENCE_TYPE 
renames INFER_ENG_SUB . GET_SALIENCE_THRESHOLD ; 


-- Set the minimum salience below which rules may not fire. The constant 
- — min salience may be used to reset salience to the initial default. 

function SET_SALIENCE_THRESHOLD (SALIENCE : in INTEGER JTYPE) return INTEGER_TYPE 
renames INFER ENG_SUB . SET_SALIENCE_THRESHOLD ; 


— Returns the default limit on rule firings for run. If the returned value 

— is negative, the default is to let ART run Indefinitely 


function GET_L IMI T_DEF AULT return INTEGER_TYPE 
renames INFER ENG SUB. GET LIMIT_DEFAULT ; 


-- sets the default limit on rule firings for run. If limit is 
-- negative, the default is to let ART run indefinitely. 

function SET_LIMIT_DEFAULT (LIMIT : in INTEGER_TYPE) return INTEGER JTYPE 
renames INFER ENG SUB . SET_LIMIT_DEF AULT ; 


-- Returns a boolean that tells whether ART prints informational messages. 
TRUE means they are printed; FALSE means they are suppressed. 


function GET_PRINT_MESSAGES return BOOLEAN 
renames INFER ENG SUB . GET_PRINT_MESSAGES ; 


-- Controls whether ART prints informational messages. TRUE means 
-- to print messages; FALSE to suppress printing of messages. 

— TRUE is the default. 


function SET_PRINT_MESSAGES (VALUE BOOLEAN) return BOOLEAN 
renames INFER ENG SUB . SET_PRINT_MESSAGES ; 


-- Convert INTEGERJTYPE to BOOLEAN. If 0, then FALSE. TRUE, otherwise. 

function INTEGER JT0_B00LEAN (STATUS : INTECER_TYPE) return BOOLEAN 
renames CALLIQ_SUB INTEGER_T0_B00LEAN ; 


-- Convert BOOLEAN to INTEGER JTYPE . If TRUE, then 1. If FALSE, then 0 
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function BGQLEAN_TO_ INTEGER (STATUS : BOOLEAN) return INTEGER^TYPE 
renames CALLIO_SUB . BQQLE1AN_T0 INTEGER, 


-- Function: It frees a sequence 


procedure FREESEQUENCE (X : m out ART_0B JECT) 
renames ALLCC_SUB FREE SEQUENCE; 


— Function: Prints the object followed by a CR LF to the standard output 
Standard output is, by default, the screen. 

-- Parameters: OBJECT - The object to be printed 


function PRINT (OBJECT : ARTJ3BJECT; 

STREAM: ARTJDBJECT := null) return ART_0B JECT 
renames 10 SUB. PRINT, 


-- Function: Prints the ART Object to the standard output. 

Standard output is, by default, the screen. 
Puts quotes around the string being printed. 

— Parameters: OBJECT - The ART Object to be printed 


function PRIN1 (OBJECT : ART_Q8 JECT ; 

STREAM: ART_G9 JECT := null) return ART_OBJECT 
renames 10 SUB . PRIN1 , 


-- Function: Prints the object to the standard output. 

Standard output is, by default, the screen. 

-- Parameters: OBJECT - The object to be printed 


function PRINC (OBJECT : ART_0B JECT , 

STREAM: ART_08 JECT := null) return ART_0BJECT 
renames 10 SUB. PRINC, 


-- Function: Prints a CR to the standard output 

Standard output is, by default, the screen 


procedure TERPR I (STREAM : ART_0B JECT := null) 
renames IQ SUB.TERPRI; 


— Prints out a list of objects to the given stream The symbol T indicates 
-- that a newline should be emitted. The symbol T as the stream argument 

— indicates that stdout should be used as the stream (for compatibility with 

— big Art). Conceptually, the argument list of printout is: 

printout (stream trest args) 

— For now, ignore the first arg, STREAM. 


function PRINTOUT (STREAM ART_0B JECT ; 

REST ART_0B JECT_ARRAY_PTR_TYPE) return BOOLEAN 
renames 10 SUB PRINTOUT, 


-- Function: Read from standard output. 
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-- Parameters: OBJECT - The ART_QBJECT being read. 


function READ_ INTERFACE (STREAM ART_0B JECT : = null) return ART_OBJECT 
renames I0_SUB . READ_INTERFACE , 

end ART; 
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III. 2 Specification of ERROR _HDL_ SUB Package 
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COPYRIGHT NOTICE 

1) COPYRIGHT (C) 1938 
INFERENCE CORPORATION, 

5300 V, Century B1 vd . , 

Los Angeles, California 90045. 

AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED 

2) Restricted Rights Notice (Short Form) (April 1984) 

Use, reproduction, or disclosure is 
subject to restrictions set forth In 
Government Cooperative Agreement Number NCC- 
9-16 between the National Aeronautics and 
Space Administration and the University of 
Houston-Clear Lake and a subcontract 
thereunder, Number 015 between the University 
of Houston-Clear Lake and Inference 
Corporation . 

3) Restricted Rights Notice (ART/Ada) 

These data constitute Inference 
Corporation trade secrets and/or information 
that is commercial or financial and 
confidential or privileged. They are 
submitted to the Government under NASA 
Cooperative Agreement NCC-9-16 with the 
University of Houston-Clear Lake Research 
Institute for Computing and Information 
Systems (RICIS) with the understanding that 
they will not, without the permission of 
Inference Corporation, be used or disclosed 
for other than evaluation purposes 


-- Author: Jim Badura 
-- Package: ERR0R_HDL_SUB 

-- Function: This package contains a procedure that performs error 

recovery for internal ART errors. 

— State Variables: None 

— State Variable Initialization: None 
-- Change Log: 


with STRUCT J3CL, CALENDAR; 
use STRUCT_DCL; 

package ERRQR_HDL_SUB is 

type ERR0R_LQC is (LHS_L0C, RHS_L0C, T0PLEVEL_L0C , ASYNC_L0C) . 

type ERR0R_TYPE is (CQNSTRAINT_ERR , NUMERIC_ERR , PR0GRAM_ERR , ST0RAGE_ERR . 
TASKING_ERR , TIME_ERR, 

INTERNAL_ERR , RETRACT_ERR , I NTERPRETER_ERR , 

USER_ERR , 

USER_DEFINED_£RR) ; 
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TIME_ERROR : exception renames CALENDAR . TIME ERROR; 

INTERNAL_ERROR exception; 

RETRACT_ERROR exception, 

INTERPRETER_ERROR : exception; — Error In the interpreter 

USER_ERROR exception, -- The User can use this exception. 

USER_DEFINED_ERROR : exception, -- The User can use this exception 


-- Function: This procedure invokes the appropriate Ada routine for 
recovering from the current internal ART error 
This procedure should be separate. 

— Parameters: ERROR - The current error being handled 


procedure PROCESS_ERROR (ERROR : in ERROR TYPE); 


-- Function: This procedure stores an error message into a buffer 

so that the error message could be printed by PR0CESS_ERR0R later 

Parameters MESSAGE - The error message, 
procedure ERROR (MESSAGE ; in STRING); 


Function: This procedure handles an warning message. 
This" procedure should be separate. 

Parameters: MESSAGE - The warning message. 


procedure WARNING (MESSAGE : in STRING), 


end ERROR HDL SUB; 
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III. 3 Body of ERROR _HDL SUB Package 
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COPYRIGHT NOTICE 

1) COPYRIGHT (C) 1988 
INFERENCE CORPORATION, 

5300 W Century Blvd., 

Los Angeles, California 90045 
AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED. 

2) Restricted Rights Notice (Short Form) (April 1984) 

Use, reproduction, or disclosure is 
subject to restrictions set forth in 
Government Cooperative Agreement Number NCC- 
9-16 between the National Aeronautics and 
Space Administration and the University of 
Houston-Clear Lake and a subcontract 
thereunder. Number 015 between the University 
of Houston-Clear Lake and Inference 
Corporation . 

3) Restricted Rights Notice (ART/Ada) 

These data constitute Inference 
Corporation trade secret s and/or information 
that is commercial or financial and 
confidential or privileged. They are 
submitted to the Government under NASA 
Cooperative Agreement NCC-9-16 with the 
University of Houston-Clear Lake Research 
Institute for Computing and Information 
Systems (RICIS) with the understanding that 
they will not. without the permission of 
Inference Corporation, be used or disclosed 
for other than evaluation purposes. 


-- Author: Jim Badura 
-- Package ERR0R_HDL_SUB 

Function this package contains a procedure that performs error 
recovery for internal ART errors. 

— State Variables: None 

-- State Variable Initialization: None 

-- Change Log: 


with GLQ8AL_DCL , 

use GL0BAL_DCL ; 

package body ERRQR_HDL_SUB is 


Function: This procedure invokes the appropriate Ada routine for 
■recovering from the current internal ART error. 

-- Parameters: ERROR - The current error being handled 


procedure PR0CESS_ERR0R(ERR0R : in ERR0R_TYPE) is separate; 
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— Function: This procedure stores an error message into a buffer 

so that the error message could be printed by PROCESS_ERRCR later. 

-- Parameters MESSAGE - The error message 


procedure ERROR (MESSAGE in STRING) Is 
begin 

CHARACTER^STR I NG COPY (MESSAGE. CURJJSER ERROR_BUFFER) ; 
end ERROR. 


-- Function: This procedure handles the warning message. 
— Parameters: MESSAGE - The warning message. 


procedure WARNING (MESSAGE : in STRING) is separate, 
end ERROR HDL SUB; 
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III. 4 Separate Procedure 

ERROR _HDL_ SUB. PROCESS ERROR 
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COPYRIGHT NOTICE 

1) COPYRIGHT (C) 1988 
INFERENCE CORPORATION, 

5300 V. Century Bird., 

Los Angeles, California 90045. 

AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED 

2) Restricted Rights Notice (Short Form) (April 1984) 

Use, reproduction, or disclosure is 
subject to restrictions set forth in 
Government Cooperative Agreement Number NCC- 
9-16 between the National Aeronautics and 
Space Administration and the University of 
Houston-Clear Lake and a subcontract 
thereunder. Number 015 between the University 
of Houston-Clear Lake and Inference 
Corporation . 

3) Restricted Rights Notice (ART/Ada) 

These data constitute Inference 
Corporation trade secret s and/or Information 
that is commercial or financial and 
confidential or privileged. They are 
submitted to the Government under NASA 
Cooperative Agreement NCC-9-16 with the 
University of Houston-Clear Lake Research 
Institute for Computing and Information 
Systems (RICIS) with the understanding that 
they will not, without the permission of 
Inference Corporation, be used or disclosed 
for other than evaluation purposes. 


with TEXT_I0; 
use TEXT_I0 ; 
separate (ERR0R_HDL_SU8) 

procedure PROCESS _ERR0R (ERROR : in ERR0R_TYPE) is 
ERR: constant STRING := ERROR: " ; 

begin 

case ERROR is 

when CONSTRAINT_ERR 

=> PUT_LINE(ERR t 'Constraint error - ); 
when NUMERIC_ERR 

=> PUT_LINE(ERR k 'Numeric error - ); 
when PROCRAM_ERR 

=> PUT_LINE(ERR ft "Program error - ), 
when ST0RAGE_ERR 

=> PUT_LINE(ERR ft 'Storage error') ; 
when TASKING_ERR 

=> PUT_LINE(ERR k 'Tasking error') ; 
when TIMEERR 

=> PUT_LINE(ERR k 'Time error - ) ; 
when INTERNAL_ERR 

=> PUT LINECERR k 'Internal ART error: ' k 

CHARACTER_STR I NG . SUBSTRING_0F(CUR_USER . ERR0R_BUFFER) ) , 
CHARACTER_STR I NG . CLEAR (CUR_USER . ERR0R_BUFFER) ; 
when RETRACT_ERR 

=> PUT_LINE(ERR k 'Retract error: - k 

CHARACTER_STR I NG . SUBSTRING_0F (CURJJSER . ERR0R_BUFFER) ) . 
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CHARACTER_STRING . CLEAR (CUR_USER . ERROR_BUFFER) ; 
when I NTERPRETER_ERR 

=> PUT_LINE(ERR t 'Interpreter error: * ft 

CHARACTER_STRING . SUBSTRING_OF (CURJJSER . ERROR BUFFER) ) ; 
CHARAC7ER_STRING . CLEAR (CURJJSER . ERRGR_BUFFER) , 
when USER ERR 

=> PUT_LINE(ERR ft 'User error - ft 

CHARACTER_STRING . SU8STRING_0F (CUR_USER . ERROR_BUFFER) ) . 
CHAftAC7ER_STRING . CLEAR (CURJJSER ERROR_BUFFER)’; 
when USER_DEFINED_ERR 

-> PUT LINECERR ft "User defined error"), 
end case; 

end PROCESS ERROR, 
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ffl.5 Separate Procedure ERROR _ HDL _ SUB. WARNING 


COPYRIGHT NOTICE 

1) COPYRIGHT CC) 1980 
INFERENCE CORPORATION , 

5300 W Century Blvd., 

Los Angeles, California 90045 
AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED. 

2) Restricted Rights Notice (Short Form) (April 1984) 

Use, reproduction, or disclosure is 
subject to restrictions set forth in 
Government Cooperative Agreement Number NCC- 
9-16 between the National Aeronautics and 
Space Administration and the University of 
Houston-Clear Lake and a subcontract 
thereunder. Number 015 between the University 
of Houston-Clear Lake and Inference 
Corporation . 

3) Restricted Rights Notice (ART/Ada) 

These data constitute Inference 
Corporation trade secrets and/or information 
that is commercial or financial and 
confidential or privileged. They are 
submitted to the Government under NASA 
Cooperative Agreement NCC-9-16 with the 
University of Houston-Clear Lake Research 
Institute for Computing and Information 
Systems (RICIS) with the understanding that 
they will not, without the permission of 
Inference Corporation, be used or disclosed 
for other than evaluation purposes. 


with TEXTJ0; 

use TEXT__I0 ; 

separate *(ERR0R_HDL_SUB) 

procedure WARNING (MESSAGE : in STRING) is 

begin 

PUT LINEC ; , . WARNING. * * MESSAGE) ; 
end WARNING; 
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m.6 Specification of USER INTERFACE Package 
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Proprietary Rights of Inference Corporation in the ART (TM) , 
ARTLV(TM), ART StUdio(TM) , ARTIST (TM) and 
Viewpoints (TM) programs include the following: 

1) The ART (R) , ART Studlo(TM), ARTIST (TM) 

and Viewpoints (TM) programs and related data and 
information are the subject of TRADE SECRETS and 
COPYRIGHTS licensed from INFERENCE CORPORATION. 

The program and related data and information are 
provided in confidence and all use, disclosure, 
copying, or storage except as authorized in the 
written LICENSE AGREEMENT FROM INFERENCE to the 
user, is strictly prohibited. 

2) COPYRIGHT (C) 1988, 1987, 1986, 1985, 1984 INFERENCE CORPORATION, 
5300 V. Century Blvd , Los Angeles, California 90045. 

AN UNPUBLISHED WORK - - ALL RIGHTS RESERVED. 

3) RESTRICTED RIGHTS LEGEND: 

When the Licensee is the US. Government or a duly 
authorized agency thereof, use, duplication, or disclosure 
by the US. Government is subject to restrictions as set 
forth in subivision (b) (3) (ii) of the Rights in 
Technical Data and Computer Software clause at 
52.227-7013, dated November 9, 1984 


-- Author: J. T. Badura 
-- Package: USER_I NTERF ACE_SUB 

-- Function: This package contains subprograms that controls the user 
interface 

-- State Variables: None 

-- State Variable Initialization: None 

-- Change Log: 


with STRUCT_DCL ; 

use STRUCT_DCL , 

package USER_INTERFACE_SUB is 

-- Function: This procedure Invokes the interactive ART/Ada command loop. 

This procedure will display the initial banner and repeatly 
print the ART/Ada prompt for a ART command. 

The command loop should handle watch/unvatch , reset, run, 
agenda, facts. 


procedure C0MMAND_LQOP ; 


— FACTS: 
-- to the 
-- sum of 

Prints out a list of the current 
screen, in sorted order and with 
the total current facts 

facts 

a 

procedure 

FACTS , 


— AGENDA. 

Prints out the agenda of the rules 
that are ready to fire. 
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procedure AGENDA, 


— Timed_run: Calls a timing function to determine the amount of 
time a run has taken 


procedure TIMED_RUN(RUN_LIMIT : INTECER_TYPE) ; 
end USER INTERFACE SUB; 
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IV. Benchmark Programs 

This appendix includes the following ART-IM programs used to benchmark the ART Ada prototype: 

• Monkey and Banana 

• N-Queens (6 Queens) 
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IV. 1 Monkey and Banana 
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;; -*- Mode: ART; Base: 10.; Package: ART-USER 


Monkees and Bannanas Sample Problem 

This is an extended version of a 
rather common AI planning problem. 

The point is for the monkee to find 
and eat some bannanas. 

To execute, merely load, reset and run. 


; ****** ******** *********** 

;;,* chest unlocking rules * 

^ *********** ************** 

(defrule unlock-chest-to-hold-obj ect " ' 

(goal-is-to active holds 7 obj) 

(object ?ch est ? 7 7 ?obj 7 ) 

(not (goal-is-to active unlock ?chest)) 

=> 

(assert (goal-is-to active unlock 7 chest))) 

(defrule unlock-chest- to-move-obj ect 
(goal-is-to active move ?obj 7 ) 

(object ?chest ? ? 7 ?obj ?) 

(not (goal-is-to active unlock ?chest)) 

= > 

(assert (goal-is-to active unlock 7 chest))) 

(defrule hold-chest-to-put-on-f loor 
(goal-is-to active unlock ?chest) 

(object ?chest ? light “floor ? 7 ) 

(not (goal-is-to active holds 7 chest)) 

=> 

(assert (goal-is-to active holds ?chest))) 

(defrule put-chest-on-floor •• 

(goal-is-to active unlock 7 chest) 

7 fl <- (monkey 7 place 7 on 7 chest) 

? f 2 <- (object 7 chest held light held 7 contains 7 key) 

=> 

; (printout t 'Monkey throws * ?chest ■ off • ?on " onto floor ' t) 
(retract 7 fl 7 f2) 

(assert (monkey 7 place ?on blank)) 

(assert (object 7 chest ?place light floor 7 contains ?key))) 

(defrule get-key-to-unlock •• 

(goal-is-to active unlock 7 obj) 

(object 7 ob J 7 place 7 floor 7 7 key) 

(monkey ? ? ~ 7 key) 

(not (goal-is-to active holds ?key)) 

=> 

(assert (goal-is-to active holds ?key))) 

(defrule move- to-chest-with-key 
(goal-is-to active unlock 7 chest) 

(monkey 7 mplace ? 7 key) 

(object 7 chest 7 cp lacefc~ 7 mplace 7 floor 7 7 key) 

(not (goal-is-to active walk-to 7 cplace)) 

= > 

(assert (goal-is-to active walk-to 7 cplace))) 
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(defrule unlock-chest-vi th-key •• 

?fl <- (goal-is-to active unlock ’chest-obj) 

?f2 <- (object ’chest-obj ’place ’weight ’on ’obj -in ’key) 

(monkey ’place ’on ’key) 

= > 

; (printout t "Monkey opens chest with " ’key ■ revealing • ’obj-in t) 
(retract ?fl ?f2) 

(assert (object ?chest-obj ?place ’weight ’on nil ’key)) 

(assert (object ’obj-in ’place light ’chest-obj nil nil))) 


. ; ; * process hold object * 


(defrule use-ladder-to-hold •* 

(goal-is-to active holds ?obj) 

(object ’obj ?place light ceiling ? ’) 

(not (goal-ls-to active move ladder ’place)) 

=> 

(assert (goal-is-to active move ladder ’place))) 

(defrule cl iab- ladder-to-hold " 

(goal-is-to active holds ?obj) 

(object ?obj ’place light ceiling ? ’) 

(object ladder ’place ’ floor ’ ’) 

(not (goal-is-to active on ladder)) 

=> 

(assert (goal-is-to active on ladder))) 

(defrule grab-ob j ect-f rom-ladder ■■ 

’fl <- (goal-is-to active holds ?obj) 

’f2 <- (object ’obj ’place light ceiling ’contains ’key) 
(object ladder ’place ’ ’ ’ ’) 

’ f 3 <- (monkey ’place ladder blank) 

= > 

; (printout t "Monkey grabs the " ?obj t) 

(retract ?fl ?f2 ’f3) 

(assert (object ’obj held light held ’contains ’key)) 
(assert (monkey ’place ladder ’obj))) 

(defrule cl iib- to-hold 

(goal-is-to active holds ’obj) 

(object ’obj ’place light ?on*“f loork'ce i li ng ’ ?) 
(monkey ?place '?on ’) 

(not (goal-is-to active on ’on)) 

= > 

(assert (goal-is-to active on ’on))) 

(defrule valk-to-hold •• 

(goal-is-to active holds ’obj) 

(object ’obj ’place light 'ceiling ’ ’) 

(monkey “’place ? ?) 

(not (goal-ls-to active valk-to ’place)) 

_> 

(assert (goal-is-to active valk-to ’place))) 

(defrule drop-to-hold ■■ 

(goal-is-to active holds ’obj) 

(object ’obj ’place light floor ’ ’) 

(monkey ’place ’ 'blank) 

(not (goal-is-to active holds blank)) 

r > 

(assert (goal-is-to active valk-to ’place))) 
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(defrule get-on-f loor-to-hold 
(goal-is-to active holds ’obj) 

(object ’obj ’place light floor 7 7 ) 

(monkey 7 place 'floor 7 ) 

(not (goal-is-to active on floor)) 

= > 

(assert (goal-is-to active on floor))) 

(defrule grab-object 

7 fl <- (goal-is-to active holds 7 obj) 

? f 2 <- (object 7 ob j 7 place light 7 on 7 contains ’key) 

7 f3 <- (monlcey 7 place 7 on blank) 

r> 

; (printout t 'Monkey grabs the * 7 obj t) 

(retract ?fl 7 f2 ?f3) 

(assert (object 7 obj held light held ’contains 7 key)) 
(assert (monkey ’place ’on ?obj))) 

• ********** **************** 

;;;* move object to a place * 

;*************************» 

(defrule hold-ob j ect- to-move " 

(goal-is-to active move ’obj ’place) 

(object ’obj "’place light ’ ’ ’) 

(monkey ? 7 "’obj) 

(not (goal-is-to active holds ’obj)) 

=> 

(assert (goal-is-to active holds ’obj))) 

(defrule move-obj ect-to-place " 

(goal-is-to active move ’obj ’place) 

(monkey "’place ’ ’obj) 

(not (goal-is-to active walk-to ’place)) 

=> 

(assert (goal-is-to active walk-to ’place))) 

(defrule drop-object-once-moved " 

?fl <- (goal-is-to active move ’obj ’place) 

?f 2 <- (monkey ’place ’on ’obj) 

’ f 3 <- (object ?ob j ? light ’ ’contains ’key) 

=> 

(printout t 'Monkey drops the " ’obj • * t) 

(retract ’fl ?f2 7 f3) 

(assert (monkey ’place ’on blank)) 

(assert (object ’obj ’place light floor ’contains ’key))) 

(defrule already-moved-obj ect " 

?fl <- (goal-is-to active move ’obj ’place) 

(object ?ob j ’place ? ’ ? ’) 

=> 

(retract ?fl)) 

- ************************* 

; ; * process valk-to place * 
t ********************** * * * 


(defrule already-at-place " 

’fl <- (goal-is-to active walk-to ’place) 
(monkey ’place ’ ?) 

=> 

(retract ’fl)) 

(defrule get-on-f loor-to-walk " 
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(goal-is-to active valk-to ?place) 

(monkey “’place ’floor ?) 

(not (goal-is-to active on floor)) 

=> 

(assert (goal-is-to active on floor))) 

(defrule valk-holding-nothing ■■ 

9 fl <- (goal-is-to active vallc-to ’place) 

9 f2 <- (monkey “’place floor blank) 

= > 

(printout t “Monkey walks to ■ ?place t) 

(retract ?fl ’f2) 

(assert (monkey ’place floor blank))) 

(defrule walk-holding-ob j ect ■■ 

7 fl <- (goal-is-to active vallc-to ’place) 

’f2 <- (monkey “’place floor ’ob j fc'blank) 

=> 

(printout t "Monkey walks to ■ ?place • holding ■ ’obj t) 
(retract ?fl ’f2) 

(assert (monkey ’place floor ’obj))) 

(defrule drop-object ■■ 

’fl <- (goal-is-to active holds blank) 

’ f 2 <- (monkey ’place ?on ’objfc'blank) 

7 f3 <- (object ?obJ held light held ?inside ’key) 

=> 

(printout t "Monkey drops " ’obj t) 

(retract ’fl ?f2 ’f3) 

(assert (object ’obj ’place light ’on ’inside ’key)) 
(assert (monkey ’place ’on blank))) 


, , ************************* 

.,, * process get on object * 

******** ****************, 

(defrule j ump-onto-f loor •• 

’fl <- (goal-is-to active on floor) 

’ f 2 <- (monkey ’at ?on*“floor ’obj) 

=> 

' (printout t "Monkey jumps off • ’on - onto the floor • t) 
(retract ’fl ’f2) 

(assert (monkey ’at floor ’obj))) 

(defrule valk-to-place-to-cl imb " 

(goal -is- to active on ’obj) 

(object ’obj ’place ? ? ? ’) 

(monkey “’place ? ?) 

(not (goal-is-to active valk-to ?place)) 

=> 

(assert (goal-is-to active valk-to ’place))) 

(defrule drop-to-cl imb ■■ 

(goal-is-to active on ’obj) 

(object ’obj ’place ? ? ? ?) 

(monkey ’place ’ “blank) 

(not (goal-is-to active holds blank)) 

=> 

(assert (goal-is-to active holds blank))) 

(defrule climb-indirectly •• 

(goal-is-to active on ’obj) 

(object ’obj ’place ’ ’on ’ ’) 

(monkey ’place “’on*“’obj blank) 
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(not (goal-is-to active on 7 on)) 

=> 

(assert (goal-is-to active on 7 on))) 

(defrule cl imb~d irectly " 

7 fl <- (goal-is-to active on 7 obj) 

(object 7 obj 7 place ? ?on ? 7 ) 

7 f2 <- (monkey 7 place 7 on blank) 

-> 

(printout t 'Monkey climbs onto " 7 obj t) 
(retract 7 fl 7 f2) 

(assert (monkey 7 place ?obj blank))) 

(defrule already-on-ob J ect *• 

7 fl <- (goal-is-to active on 7 obj) 

(monkey 7 ?obj 7 ) 

=> 

(retract ?fl)) 


process eat object * 


(defrule hold-to-eat " 

(goal-is-to active eat 7 obj) 

(monkey ? 7 ~?obj) 

(not (goal-is-to active holds ?obj)) 

=> 

(assert (goal-is-to active holds ?obj))) 

(defrule satisf y-hunger 
7 fl <- (goal-is-to active eat ?obJ) 

7 f 2 <- (monkey ? place 7 on 7 obj) 

? f 3 <- (object ?ob j 7 7 7 7 7 ) 

= > 

(printout t 'Monkey eats the ■ ?obj " . ■ t) 
(retract ?fl ?f2 ?f3) 

(assert (monkey 7 place 7 on blank))) 

;*****»*#*««* * ** * * 

; ; ; * initial-state * 

'*****#*«*»*«***## 


(defrule startup " 
(start-fact) 


(assert (monkey t5-7 green-couch blank)) 

(assert (object green-couch t5-7 heavy floor foo foo)) 

(assert (object red-couch t2-2 heavy floor foo foo)) 

(assert (object big-pillow t2-2 light red-couch foo foo)) 

(assert (object red-chest t2-2 light big-pillow ladder red-key)) 
(assert (object blue-chest t7-7 light ceiling bananas blue-key)) 
(assert (object blue-couch t8-8 heavy floor foo foo)) 

(assert (object green-chest t8-8 light ceiling blue-key red-key)) 
(assert (object red-key tl-3 light floor foo foo)) 

(assert (goal-is-to active eat bananas))) 


(deffacts start-fact (start-fact)) 
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An ART-IM version of NQUEENS. 

Rich Schroeppel October 1988 
Copyright (C) 1988 Inference Corp . 

The problem Is to place N queens on an NxN chessboard so that no queen 
attacks another. (A queen attacks another if they are on the same row, 
column, or diagonal.) 

Example: - Q * - 

3 

Q 

- - Q - 

To run the demo, load this file into ART. Then reset and run it. 

(load *xxx/nqueens . art* ) 

(reset) 

(run) 

When the program asks “How many rows on the board?*, type 4 and then ENTER . 
To run the program again, just (reset) and (run), 


ART features illustrated in this program: 

Defglobal 

Defrule 

Salience 

A startup rule, with null left-hand-side 
Pattern tests with *: 

Sequence variables. Variable length facts 
Assert, Retract. Binding a fact variable with <- 
Procedural language: 

Bind, Arithmetic, Absolute value function. Comparisons with = and < 
Sequence functions and predicates: Length!, Nth$, Member! 

Iteration and Conditionals: For, Dovnto, If, Not 

Input-Output: Read, Printout, character strings 

Board size 123456789 

Number of solutions 1 0 0 2 10 4 40 92 352 

(Solutions that are reflections or rotations of another solution are 
considered distinct.) 

Since there are as many queens as rows of the chessboard, each row must 
contain exactly one queen. This program generates partial solutions in 
which the first K rows of the board are filled with K non-attacking queens. 
We begin with a blank board. The partial solutions are extended one 
row/queen at a time. When the newly added queen attacks a previous queen, 
the extended partial solution is discarded. Any partial solution that 
has N rows filled in is a true solution, and is printed. 

A partial solution is represented as (SOLUTION cl c2 . ck) . Cl . ck 

are numbers between 1 and N. Cl is the column of the queen in row i. 


(defglobal ?count = 0) ;Count of solutions 

(defglobal ?print = NIL), This may be set to NIL to turn off printing. 

(defrule ask -user- for- p rob 1 e m-s i ze 

■Ask the user how big the chessboard is." 

=> 

; (printout t t *How many rows on the board? *) 

; (bind 7 n (read)) 

(bind 7 n 6) ,6 queens 

(assert (problem-size ?n) (solution)) 
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(bind ?count 0)) 

(defrule grow-solution 

■Extend a partial solution by adding another queen." 

(problem-size 7 n) 

(solution $?x) 

=> (if (< (lengths 7 x) ?n) then 
(for ?1 from 1 to 7 n do 

(if (not (members 7 1 7 x)) then (assert (solution $ 7 x 7 i)))))) 

.The '.not (members 7 i 7 x)) condition checks that no previous queen 
.occupies column ?i . 

(defrule prune-d i agonal -attacks 

This rule kills off solutions in which a newly added queen attacks a 
previous queen along a diagonal." 

(declare (salience 20)) ,High salience to kill bad solutions immediately 
?fact <- (solution $ 7 x 7 c) 

=> (bind 7 xlen (lengths 7 x)) 

(for 7 1 from ?xlen downto 1 do 

(if (= (- (* 7 xlen 1) ?i) (abs (- 7 c (nth$ 7 x ?!)))) then 
(retract ?fact)))) 

(defrule print-solution 

■This rule detects solutions and prints a chessboard showing the position 
of the queens." 

(problem-size ?n) 

(solution $?x* : (= (lengths 7 x) 7 n)) 

=> (bind ?count (+,?count t)) 

(if 7 print then 

(printout t t "Solution • 7 count * : ■ t) 

(for ?rov from l to 7 n do 
(bind ?qrc (nth$ 7 x 7 rov) ) 

(for ?column from 1 to 7 n do 

(if (- ?qrc 7 column) then (printout t • Q") else (printout t " -"))) 
(printout t t))) ) 

(defrule print-total 

"This rule prints the total number of solutions." 

^declare (salience -20)) .Wait for solutions to be generated. 

-> (printout t t "Total solutions • 7 count t) ) 
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V. Test Programs 

This appendix includes the following ART-Dvl programs used to validate the ART/Ada prototype: 

• Sweeptop: Contains about 30 rules that test the rule RHS. 

• Sweep2 : Contains about 270 rules that test the pattern/join network 
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V.l Sweeptop 
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This file contains a multitude of simple “top-level" command 
tests of ART/C. It Is Intended to be se if -d iagnostic ; at least, 
it should either die horribly or complain if any part of ART/C 
; ; ; is broken . BDC 

;; if dribble Isn’t working, or if its behavior has changed 
;; substantially, large parts of this program will blow up. 

********************************************************************** 

(defrule if-test ■■ 

=> 

(printout t "IF tests..." t) 

(if t then t else (printout t ■>>>>> IF error 1." t)) 

(if nil then (printout t •>>>>> IF error 2." t) 
else t) 


• *********************************** *********************************** 

(defrule bind-test-1 
=> 

(printout t "BIND tests..." t) 

(bind 7 dl foo) 

(if (not (equal 7 dl foo)) 

then (printout t •>>>>> BIND error 1." t)) 


(defrule bind-test-2 ■■ 

=> 

(bind ?dl "foo") 

(if (not (equal ?dl "foo")) 

then (printout t ">>>>> BIND error 2 " t)) 


(defrule bind-test-3 "" 

=> 

(bind ?d 1 12) 

(if (not (equal ?dl 12)) 

then (printout t *>>>>> BIND error 3." t)) 


(defrule bind-test-4 "" 

=> 

(bind ?di 12.45) 

(if (not (equal ?dl 12.45)) 

then (printout t •>>>>> BIND error 4." t)) 


********************************************************************** 
;;; Need a scratch defglobal for later use: 

(defglobal ?scratch = "foo") 

(defglobal ?b = "foo") 

(defglobal ?c = 55) 

(defglobal ?d = 55.55) 

(defglobal ‘’e = foo) 

(defrule def global-test-1 "" 

=> 

(printout t "DEFGLOBAL tests. " t) 

(if (not (equal ?b "foo")) 

then (printout t •>>>>> DEFGLOBAL error 1" t)) 


(defrule defglobal-test-2 


spring 

integer 

float 

symbol 
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=> 

(if (not (equal ?c 55)) 

then (printout t *>>>>> DEFGLOBAL error 2 " t) ) 

) 

(defrule defglobal- test-3 11 
-> 

(if (not (equal ?d 55 55)) 
then (printout t •>>>>> DEFGLOBAL error 3" t)) 

) 

(defrule defglobal-test-4 
=> 

(if (not (equal ?e foo)) 

then (printout t ">>>>> DEFGLOBAL error 4* t)) 

) 




(defrule print-test 
= > 

(printout t "Tests of PRINT ****** 
(print foo ) 

(print 12 ) 

(print 12.456 ) 

(print * foo bar* ) 

(print (equal 1 1) ) 

(print (equal 1 2) ) 

(printout t t "Tests of PRINl ***** 
(print 12.456 ) 

(printout t t) 

(prinl foo ) 

(print 12 ) 

(prinl "foo bar" ) 

(prinl (equal 1 1)) 

(prinl (equal 1 2)) 


t) 

; symbol 
; integer 

; float 

, string 
; T 

; NIL 

• t) 

; float 

; to separate tests 
, symbol 
. integer 
. string 
; T 

, NIL 


(printout t t "tests of PRINC ***** 
(printout t t) 

(princ 12.456 ) 

(printout t t) 

(princ foo ) 

(princ 12 ) 

(princ "foo bar" ) 

(princ (equal 1 1) ) 

(princ (equal 1 2) ) 


t) 


, float 


. to separate tests 


; symbol 
. integer 
; string 
; T 

, NIL 


(printout t t "tests of PRINTOUT ****** t) 
(printout t t) 

(printout t 12,456) 

(printout t t) 

(printout t foo) 

(printout t 12 t) 

(printout t "foo bar" t) 

(printout t (equal 1 1) t) 

(printout t (equal 1 2)) 


to separate tests 
float 

to separate tests 

symbol 

integer 

string 

T 

NIL 


; , complex formatting commands 
(printout t t) 

(printout t "tests of TERPRI ****** t) 
(printout t t "foo") 

(terpri) 

(printout t *bar" t) 


; to separate tests 
; to separate tests 
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) 

*********************************** ** ******* ******* ********* * **** ** *** 
(defrule eq-and-test ■■ 

=> 

(printout t “EQ and •) 


(if 

(not 

(eq foo foo)) 







then 

(printout t ■>>>>> 

EQ 

error 

l 

" t)) 

, symbols 

(if 

(not 

(eq 'foo* *foo-)) 







then 

(printout t *>>>>> 

EQ 

error 

2. 

- t)) 

; strings 

(if 

(not 

(eq 12 12)) 







then 

(printout t ■>>>>> 

EQ 

error 

3 

• t)) 

; integers 

(if 

(not 

(eq 12.45 12.450)) 







then 

(printout t ■>>>>> 

EQ 

error 

4. 

• t)) 

; floats 


sequences and facts will 

have to 

be 

tested through 

rules . 


; , , Not top-level . 

;;; There are all kinds of things that could be unequal. 

; ; ; I’ll test a few of them 

(if (eq foo foot) 

then (printout t •>>>>> EQ error 6.“ t) ) ;symbols 

(if (eq foo 'foo*) 

then (printout t ■>>>>> EQ error 7.* t)) 

(if (eq "foo* *Foo“ ) 

then (printout t •>>>>> EQ error 8 . • t)) 

(if (eq 12 12.0) 

then (printout t “>>>>> EQ error 9.* t)) .integers and = floats 

EQUAL uses EQ for most tests, but it might be good to 
;; exercise it anyway. 

(printout t 'EQUAL tests. . • t) 

(if (not (equal foo foo)) 

then (printout t “>>>>> EQUAL error 1.' t)) ;symbols 

(if (not (equal Moo' “foo*)) 

then (printout t *>>>>> EQUAL error 2.* t)) .strings 

(if (not (equal 12 12)) 

then (printout t •»>>> EQUAL error 3 ." t)) ; integers 

(if (not (equal 12.45 12.450)) 

then (printout t •>>>>> EQUAL error 4." t)) .floats 

(if (equal foo foot) 

then (printout t ■>>>>> EQUAL error 6 . “ t)) .symbols 
(if (equal foo "foo*) 

then (printout t •>>>>> EQUAL error 7.“ t)) ; symbol and similar string 
(if (equal "foo* 'Foo') 

then (printout t *>>>>> EQUAL error 8." t)) ;strings with capitalization differences 
(if (equal 12 12.0) 

then (printout t ">>>>> EQUAL error 9.“ t) ) ; integers and = floats 


.symbol and similar string 

.strings with capitalization differences 
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(printout t *NUMBERP tests...* t) 


(if 

(numberp foo) 






i symbol 


then 

(printout 

t 

•>>>>> 

NUMBERP 

error 

1 . * 

t)) 

(if 

(not 

(numberp 

12) ) 




, integer 


then 

(printout 

t 

">>>>> 

NUMBERP 

error 

2 * 

t)) 

(if 

(not 

(numberp 

12 

4)) 




. float 


then 

(printout 

t 

">>>>> 

NUMBERP 

error 

3. " 

t)) 

(if 

(numberp "foo*' 

) 





. string 


then 

(printout 

t 

•>>>>> 

NUMBERP 

error 

4 * 

t)) 

(if 

(numberp (eq 1 

D) 




; T 


then 

(printout 

t 

•>>>>> 

NUMBERP 

error 

6 . * 

t)) 

(if 

(numberp (eq 1 

2)) 




, NIL 


then 

(printout 

t 

•>>>>> 

NUMBERP 

error 

7. * 

t)) 


(defrule not-test ■■ 

=> 

(printout t "NOT tests...* t) 


(if 

(not 

o 

o 







; symbol 


then 

(printout 

t 

“>>>>> 

NOT 

error 

1 . * 

t)) 


(if 

(not 

12) 







; integer 


then 

(printout 

t 

■>>>>> 

NOT 

error 

2 . * 

t)) 


(if 

(not 

12.4) 







; float 


then 

(printout 

t 

•>>>>> 

NOT 

error 

3 * 

t)) 


(if 

(not 

•foo*) 







; string 


then 

(printout 

t 

• >>>>> 

NOT 

error 

4 . * 

t)) 


(if 

(not 

(eq 1 l)) 







; T 


then 

(printout 

t 

•>>>>> 

NOT 

error 

6. * 

t>) 


(if 

(not 

(not (eq 1 

2))) 





; NIL 


then 

(printout 

t 

•>>>>> 

NOT 

error 

7. * 

t>) 



* * ****************************************************** * ** * ********* * 

(defrule and-or-test •• 

=> 

(printout t “AND and OR tests. . . * t) 

(if (and t t nil) 

then (printout t * AND error i.“)) 

(if (not (and t t t) ) 

then (printout t *AND error 2.*)) 

(if (not (or nil t nil)) 

then (printout t “OR error 1.“)) 

(if (or nil nil nil) 

then (printout t “OR error 2.“)) 

) 

********************************************************************** 

(defrule string-append- test ■■ 
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(printout t 'STRING- APPEND tests. * t) 

(if (not (equal (string-append 'a* “b* "c") 'abc')) 

then (printout t •>>>>> STRING-APPEND error 1 * t)) 

) 

(defrule ceiling-test * * 

=> 

(printout t "CEILING tests " t) 


(if 

(not 

(equal (ceiling -1000000000 

1 ■ 1) - 

1000000000)) 


then 

(printout t ■>>>>> 

CEILING 

error 

1 

1 

t)) 

(if 

(not 

(equal (ceiling 1000000000 

1) 1000000001)) 


then 

(printout t ■>>>>> 

CEILING 

error 

2. 


t)) 

(if 

(not 

(equal (ceiling 0) 

0)) 






then 

(printout t •>>>>> 

CEILING 

error 

3. 


t)) 

(if 

(not 

(equal (ceiling -1) -1)) 






then 

(printout t ■>>>>> 

CEILING 

error 

4 


t)> 

(if 

(not 

(equal (ceiling 1) 

O) 






then 

(printout t ■>>>>> 

CEILING 

error 

5. 


t)) 

(if 

(not 

(equal (ceiling -1 

-1) -1) ) 






then 

(printout^ t •>>>>> 

CEILING 

error 

6 


t)) 

(if 

(not 

(equal (ceiling 1 . 

1) 2)) 






then 

(printout t •>>>>> 

CEILING 

error 

7. 


t)) 


(defrule truncate- test ■■ 


(printout t "TRUNCATE tests ' t) 


(if 

(not 

(equal (truncate -1000000000 

.1) 

1000000000) ) 


then 

(printout t •>>>>> TRUNCATE 

error 

1 

« 

t)) 

(if 

(not 

(equal (truncate 1000000000 

1) 1000000000)) 


then 

(printout t ■>>>>> TRUNCATE 

error 

2 

9 

t)) 

(if 

(not 

(equal (truncate 0) 0)) 






then 

(printout t •>>>>> TRUNCATE 

error 

3 

9 

t)) 

(if 

(not 

(equal (truncate -1) -1)) 






then 

(printout t •>>>>> TRUNCATE 

error 

4 

■ 

t)) 

(if 

(not 

(equal (truncate 1) 1)) 






then 

(printout t ">>>>> TRUNCATE 

error 

5. 

m 

t)) 

(if 

(not 

(equal (truncate -1.1) -1)) 






then 

(printout t •>>>>> TRUNCATE 

error 

6. 

m 

t)) 

(if 

(not 

(equal (truncate 1.1) 1)) 






then 

(printout t ■>>>>> TRUNCATE 

error 

7 

m 

t)) 


********************************************************************** 

(defrule evenp-test ■■ 

-> 

(printout t ' EVENP tests ' t) 


FINAL REPORT 
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(if 

(not 

(evenp 2)) 








then 

(printout 

t 

V 

V 

V 

V 

V 

EVENP 

error 

1 . " 

t)) 

(if 

(not 

(evenp -2)) 







then 

(printout 

t 

•>>>>> 

EVENP 

error 

2. * 

t)) 

(if 

(evenp 1) 








then 

(printout 

t 

•>>>>> 

EVENP 

error 

3. “ 

h)) 

(if 

(evenp -1) 








then 

(printout 

t 

A 

A 

A 

A 

A 

EVENP 

error 

4 . " 

t)) 


***** ************* ****************** * ******************************** * 

(defrule oddp-test ■■ 

= > 

(printout t "0DDP tests...* t) 


(if 

(oddp 2) 






then 

(printout t 

■>>>>> 

ODDP 

error 

1." t)) 

(if 

(oddp 

-2) 






then 

(printout t 

■>>>>> 

ODDP 

error 

2.“ t)) 

(if 

(not 

(oddp 1)) 






then 

(printout t 

■>>>>> 

ODDP 

error 

3.“ t)) 

(if 

(not 

(oddp -1)) 






then 

(printout t 

■>>>>> 

ODDP 

error 

4." t)) 


, ********************************************************************** 

(defrule rem-test ■■ 

=> 

(printout t “REM tests...* t) 


; . tests 

from Steele 

p. 217 





(if 

(not 

(= (rem 13 4) 1)) 






then 

(printout t 

•>>>>> 

REM 

error 

1 . " 

t)) 

(if 

(not 

(= (rem -13 

4) -D) 






then 

(printout t 

■>>>>> 

REM 

error 

2. “ 

t)) 

(if 

(not 

(= (rem 13 ■ 

-4) 1)) 






then 

(printout t 

■>>>>> 

REM 

error 

3. ■ 

O) 

(if 

(not 

(= (rem -13 

-4) -1» 





then 

(printout t 

•>>>>> 

REM 

error 

4. " 

t)) 


, (if (not (= (rera 13,4 1) 0.4)) ;ours is defined for ints only 

then (printout t •>>>>> REM error 5.* t) ) 

, (if (not (= (rea -13.4 1) -0.4)) 

then (printout t *>>>>> REM error 6.' t)) 

) 


********************************************************************** 


(defrule mod-test " 

-> 

(printout t "MOD tests..." t) 
;; tests from Steele, p. 217 

(if (not (= (mod 13 4) 1)) 
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then 

(printout t 

■>»>> mod 

error 


• t)) 

(if 

(not 

(= (mod -13 

4) 3)) 





then 

(printout t 

’>>>>> MOD 

error 

2 

' t)) 

(if 

(not 

(= (mod 13 - 

-4) -3)) 





then 

(printout t 

•>>>>> MOD 

error 

3 

’ t)) 

(if 

(not 

(= (mod -13 

-4) -1)) 





then 

(printout t 

•>>>>> MOD 

error 

4 

* t)) 


; (if (not (= (mod 13.4 1) 0.4)) ;ours is defined for ints only 

, then (printout t •>>>>> MOD error 5.* t) ) 

; (if (not ( = (mod -13.4 1) 0 6)) 

; then (printout t ■>>>>> MOD error 6." t)) 

) 

************ * * * ****** * * * ***** ****** * ************** * ** 3 * ****** * * * *** * ** * 

(defrule math-test 11 
-> 

(printout t ’MATH tests...' t) 

; ; Testing of library math functions is abbreviated to a single test 
;; for each, mainly to prove that the function is present and is properly 
;; linked with ART/C. There seems no point in trying to carefully 
;; explore for singularities and precision when the functions are 
;; beyond our reach, and will not have the same behavior from one site 
; ; to another . BDC 


(if 

(not 

(= (max 3 

2 

1.5) 3)) 




then 

(printout 

t 

■ >>>>> 

MATH 

error 

3 ■ t)) 

(if 

(not 

(= (min 3 

2 

1.5) 1 

500000)) 



then 

(printout 

t 

• >>>>> 

MATH 

error 

4.* t)) 

(if 

(not 

(= (mod 5 

3) 

2)) 





then 

(printout 

t 

■ >>>>> 

MATH 

error 

5 • t)) 

(if 

(not 

(=(>11 

5) 

2.5)) 





then 

(printout 

t 

*>>>>> 

MATH 

error 

6 . • t)) 

(if 

(not 

(= (- 1 0. 

5) 

0 5)) 





then 

(printout 

t 

■>>>>> 

MATH 

error 

7 . ■ t)) 

(if 

(not 

(= (* l 1. 

5) 

1.5)) 





then 

(printout 

t 

■>>>>> 

MATH 

error 

8 ' t)) 

(if 

(not 

(= (/ 1 2. 

0) 

0.5)) 





then 

(printout 

t 

•>>>>> 

MATH 

error 

9 " t)) 

(if 

(not 

(= l l)) 







then 

(printout 

t 

■ >>>>> 

MATH 

error 

20.* t)) 


; (if (not (/= 1 2)) 

; then (printout t ■>>>>> MATH error 21.’ t) ) .broken in 392 on VAX 
(if (not (> 2 1)) 

then (printout t ’>>>>> MATH error 22 ' t)) 

(If (not (< 1 2)) 

then (printout t •>>>>> MATH error 23 . ’ t)) 


(if (not (>= 2 1)) 
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then 

(printout t 

A 

A 

A 

A 

A 

MATH 

error 

24 ■ 

t)) 

(if 

(not 

(<= 1 2)) 







then 

(printout t 

•>>>>> 

MATH 

error 

25 . ■ 

t)) 

(if 

(not 

(= (abs -1) 

l)) 






then 

(printout t 

•>>>>> 

MATH 

error 

27 - 

t)) 


************************************ ********************************** 

(defglobal ?m = 5) .Iterative counter 

(defglobal ?n = 0) .accumulator 

(defrule while-test ■■ 

=> 

(printout t “WHILE tests,.. - t) 

(while (> ?m 0) do 

(bind ?n (♦ ? n D) 

(bind ?m (- 7 m 1))) 

(if (not (= ?n 5)) 

then (printout t “>>>>> WHILE error l. - t) ) 

) 

********************************************************************** 

; (defrule progn-test M 

; => 

; (printout t "PROGN tests. . . • t) 

; (if (not 
; (equal nil 

; (progn (bind 7 m 10) 

; (bind ?n 20) 




C= 

l 2)))) 





then 

(printout t 

■>>>>> PROGN 

error 

1 . ■ 

O) 

(if 

(not 

(- 7 ra 10)) 






then 

(printout t 

•>>>>> PROGN 

error 

2 . - 

t)) 

(if 

(not 

(= 7 n 20)) 






then 

(printout t 

■>»» PROGN 

error 

3 * 

t)) 


;) 

■ ********************************************************************** 

(deffacts inlt 

(fact one two three four five)) 

(defrule length-test-1 
■Bind a sequence to ?x" 

(fact $?x) 

=> 

(printout t - LENGTH$ tests... - t) 

(if (not (= (length$ ?x) 5)) 

then (printout t •>>>>> LENGTHS error 1.* t) ) 

) 

• ********************************************************************** 

(defrule nth-test-l 

■Bind a sequence to ?o* 

(fact $?o) 

=> 

(printout t - NTH$ tests.. - t) 

(if (not (equal (nthS ?o 3) three)) 
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then (printout t ">>>>> NTHS error 1 . “ t) ) 

) 

(defrule position-test-1 
"Bind a sequence to ? o* 

(fact $ 9 o) 

= > 

(printout t 'P0SITICN$ tests * t) 

(if (not (= (POSITIONS four ? o) 4)) 

then (printout t •>>>>> PCSITICNS error 1." t)) 

) 

(defrule member- test-1 

“Bind a sequence to 7 o" 

(fact $ 7 o) 

=> 

(printout t “MEMBERS tests... - t) 

(if (members six ?o) 

then (printout t ">>>>> MEMBERS error 1." t)) 

(if (not (members five ? o) ) 

then (printout t ">>>>> MEMBERS error 2." t)) 

) 
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Mode: ART; Base: 10.; Package: ART-USER -*- 
;;; 10-20-88 AMK added sequences tests. 


(deffacts initial-1 "Facts to match the rules in SUITE-RULEl ART" 
(test-case sdl-1 test-case) 

(test-case sdl-2 "a red flag") 

(test-case sdl-3 1) 

(test-case sdi-4 100 321) 

(test-case sdl-5) 

(test-case sdl-6 green) 

(test-case sdl-7 "green") 

(test-case sdl-8 green green) 

(test-case sdl-9) 

(test-case sdl-10 green) 

(test-case sdl-11 "green") 

(test-case sdl-12 green green) 

(sdl-13 sdl-13) 

(sdl-14 sdl-14 green) 

(sdl-15 sdl-15 "green") 

(sdl-16 sdl-16 green green) 

(sdl-17 sdl-17) 

(sdl-18 sdl-18 green) 

(sdl-19 sdl-19 "green") 

(sdl-20 sdl-20 green green) 

(sdl-21 sdl-21 blue red green) 

(sdl-22 sd 1-22 red) 

(sdl-23 red sdl-23) 

(sdl-24 sd 1-24) 

(sdl-25 sdl-25 data sdl-25) 

(sdl-26 blue fun blue) 

(sdl-27 blue fun get) 

(sdl-28 blue blue blue) 

(sdl-29 blue fun "blue") 

(sdl-30 red blue green) 

(sdl-30 purple blue green) 

(sdl-31 red blue green) 

(sdl-31 purple blue brown) 

(sdl-32 red) 

(sdl-33 green) 

(sdl-34 red) 

(sdl-35 blue) 

(sdl-36 green) 

(sdl-37 red) 

(sdl-38 blue) 

(sdl-39 green) 

(sd 1-40 red) 

(sdl-41 blue) 

(sdl-42 get) 

(sdl-43 green) 

(sdl-44 red) 

(sdl-45 green) 

(sd 1 -46 red) 

(sdl-47 blue) 

(sdl-48 green) 

(sdl-49 a red) 

(sdl-49 b red) 

(sdl-50 a red) 
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(sdl-50 

b green) 

Csdl-51 

a blue) 

(sdl-51 

b blue) 

(sdl-52 

a red) 

(sdl-52 

b red) 

(sd 1 -53 

a red) 

(sdl-53 

b blue) 

Csdl-54 

a green) 

(sdl-54 

b green) 

(sdl-55 

2) 

(sdl-56 

red) 

(sdl-57 

2) 

(sd 1-58 

2) 

(sd 1-59 

■ red ") 

(sdl-60 

2) 

(sdl-61 

"red ") 

(sdl-52 

2) 

(sdl-63 

"red") 

(sdl-64 

4) 

(sd 1-64 

9) 

(sdl-65 

data 6) 

(sdl-65 

value 9) 

(sdl-66 

1 4.00 7.00) 

(sdl-66 

2 5,00 9.00) 

(sdl-67 

datal 3) 

(sdl-67 

data2 5) 

(sdl-68 

datal 9) 

(sdl-68 

data2 5) 

(sdl-69 

datal 4) 

(sd 1-69 

data2 4) 

(sd 1-70 

datal red) 

(sdl-70 

data2 5) 

(sdl-7 1 

datal "4") 

(sdl-71 

data2 4) 

(sdl-72 

datal red) 

(sdl-72 

data2 5) 

(sdl-73 

datal red) 

(sdl-73 

data2 5) 


(sdl-74) 

(sdl-75) 

(sd 1-76) 

(sdl-77) 

(sdl-78) 

(sd 1-78 1 5) 

(sdl-78 2 8) 

(sdl-79 a b c d e f g) 

(sdl-80 a b c d e f g) 

(sdl-81 a b c d e f g) 

(sdl-108 10) 

(sdl-109 3) 
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(deffacts ini tlal-l-sequences Tacts to match the rules in SUITE-RULEl ART* 
(test-case (sdl-l test-case)) 

(test-case (sdl-2 "a red flag*)) 

(test-case (sdl-3 1)) 

(test-case (sdl-4 (100321))) 

(test-case (sdl-5)) 

(test-case (sdl-6 green)) 

(test-case sdl-7 '"green")) 

(test-case (sdl-8 green green)) 

(test-case sdl-9()) 

(test-case sdl-10 (green)) 

(test-case sdl-ll ("green")) 

(test-case (sdl-12 green green)) 

(sdl-13 (sdl-13) ) 

(sdl-14 (sdl-14 (green))) 

(sdl-15 (sdl-15 ("green"))) 

(sdl-16 (sd 1—16 (green green))) 

(sdl-17 (sdl-17) ) 

(sdl-18 (sd 1-18 green)) 

(sdl-19 (sdl-19 "green")) 

(sdl-20 (sd 1-20 green (green))) 

(sdl-21 (sdl-2i blue red green)) 

(sdl-22 (sdl-22 red)) 

(sdl-23 (red sdl-23)) 

(sdl-24 (sdl-24) ) 

(sdl-25 (sd 1-25 data sdl-25)) 

(sdl-26 (blue fun blue)) 

(sdl-27 (blue fun get)) 

(sdl-28 (blue blue blue)) 

(sdl-29 (blue fun ("blue"))) 

(sdl-30 (red (blue green))) 

(sdl-30 (purple (blue green))) 

(sdl-31 (red blue green)) 

(sdl-31 (purple blue brovn)) 

(sdl-32 (red)) 

(sdl-33 (green)) 

(sdl-34 (red)) 

(sdl-35 (blue)) 

(sdl-36 (green)) 

(sdl-37 (red)) 

(sdl-38 (blue)) 

(sdl-39 (green)) 

(sdl-40 (red)) 

(sdl-4 l (blue)) 

(sdl-42 (get)) 

(sdl-43 (green)) 

(sdl-44 (red)) 

(sdl-45 (green)) 

(sdl-46 (red)) 

(sdl-47 (blue)) 

(sdl-48 (green)) 

(sdl-49 (a (red))) 

(sdl-49 (b (red))) 

(sd 1 -50 (a (red))) 

(sdl-50 (b (green))) 

(sdl-51 (a (blue))) 

(sdl-51 (b (blue))) 
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(sdl-52 (a (red))) 

(sdl-52 (b (red))) 

(sdl-53 (a (red))) 

(sdl-53 (b (blue))) 

(sdl-54 (a (green))) 
(sdl-54 (b (green))) 

(sdl-55 (2)) 

(sdl-56 (red)) 

(sdl-57 (2)) 

(sdl-53 (2)) 

(sdl-59 (‘red")) 

(sdl-60 (2)) 

(sdl-61 (•red’)) 

(sdl-62 (2)) 

(sdl-63 (•red") ) 

(sdl-64-seq (4)) 
(sdl-64-seq (9)) 

(sdl-65 (data 6)) 

(sdl-65 (value 9)) 

(sdl-66 (1 4.00 7.00)) 
(sdl-66 (2 5.00 9.00)) 

(sdl-57 (datal G3))) 
(sdl-67 (data2 (5))) 

(sdl-68 (datal ( 9 ))) 
(sdl-68 (data2 (S))) 

(sdl-69 (datal ( 4 ))) 
(sdl-69 (data2 ( 4 ))) 

(sdl-70 (datal red)) 
(sdl-70 (data2 5)) 

(sdl-7 1 (datal " 4 ")) 
(sdl-71 (data2 4)) 

(sdl-72 (datal red)) 
(sdl-72 (data2 5)) 

(sdl-73 (datal red)) 
(sdl-73 (data2 5)) 

(sdl-74 0) 

(sdl-75 0) 

(sdl-76 0) 

(sdl-77 ()) 

(sdl-70 () ) 

(sdl-78 (1 5)) 

(sdl-78 (2 8)) 

(sdl-79 (a b c d • f g)) 

(sdl-60 (a b c d • f g) ) 

(sdl-81 (a b c d e l g)) 

(sdl-108 (10)) 

(sdl-109 (3)) 
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(deffacts initial-2 

(sdl-115 to be foo bar to be) 

(sd 1-116 a e i o u) 

(sd 1 - 1 1*7 fluff mug bump bleet lolita) 

, ; go hiking or skiing 

(non-working sdl-118) 

(weather sdl-118 major-blizzard) 

(non-working sdl-119) 

(drive sdl-119 two-wheel) 

(non-working sdl-120) 

(weather sdl-120 major-blizzard) 
(drive sdl-120 two-wheel) 

(working sdl-120 weekend) 

; ; wild card 

(sdl-121 one one) 

(sdl-122 one one one) 

(sdl-123 6545) 

(sdl-124 a r t h u r) 

(sdl-125 a rose is a rose) 

(sdl-126 to be or not to be) 

(sdl-127 frank) 

(sdl-123 1 2) 

(sdl-129 love in bloom) 

(sdl-130 a rose is a rose) 


. ; str_cat 
(sdl-131 "foo*) 

(sdl-133 first second) 

(sdl-134 republicans fox jones nixon williams harvey) 
(sdl-134 quakers pallas sanchez stone nixon fregge) 
(sdl-135 yellow) 

(sdl-135 green) 

(sdl-136 yellow) 

(sdl-136 green) 

(sdl-137 yellow) 

(sdl-138 green) 

(sdl-139 -12 12) 

(sdl-140 1 1) 

(sdl-140 1 2) 

(sdl-141 1 1) 

(sdl-141 1 2) 

(sdl-142 cold hot) 

(sdl-143 green yellow red blue white) 

(sdl-144 brother-of waiter daniel) 

(sdl-144 child-of waiter david) 

(sdl-144 sex-of david male) 

(sdl-144 child-of waiter Jane) 

(sdl-144 sex-of Jane female) 

(sdl-145-list red white blue) 

(sdl-145 red) 

(sdl-145 white) 

(sdl-145 blue) 

(sdl- 146-seats 8 9 11 14 3) 


(sdl-146-names tom carol fred alex) 
(sdl- 147 donors start fred) 

(sdl-147 donors fred John) 

(sd 1-147 donors john mike) 

(sdl-147 donors mike finish) 
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(sdl-147 donation fred 7.0) 

(sdl-147 donation John 10.0) 

(sdl-147 donation mike 0.5) 

(sdl-147-sum donors start 0) 

(sdl-148 donor-list fred John mike) 

(sd 1 - 148 donation fred 7.0) 

(sdl-148 donation John 10.0) 

(sd 1- 148 donation mike 0.5) 

(sdl-148-sum donors start 0) 

(sd 1- 149 inventory shlrt-11 7.00) 

(sdl-149 inventory pants-9 10.00) 

(sdl-149 inventory belt-14 2.50) 

(sdl-149 current-sum 0) 

(sdl-150 inventory shirt-li 7.00) 

(sdl-150 inventory pants-9 10.00) 

(sdl-150 inventory belt-14 2.50) 

(sdl-150 current-count 0) 

(sdl-151 quarter 10) 

(sdl-151 dime 8) 

(sdl-151 nickel 6) 

(sdl-151 penny 4) 

(sd 1- 152 quarter 10) 

(sdl-152 dime 8) 

(sdl-152 niclcel 6) 

(sdl-152 penny 4) 

(sdl-153 yes) 

(sdl-153 no) 

(sdl-153 unknown) 

(sdl-153 1) 

(sdl-154 foo) 

(sdl-154 1) 

(sdl-154 2) 

(Sdl-154 3) 

(sdl-155 foo) 

(sdl-155 1) 

(sdl-155 2) 

(sdl-155 3) 

(sdl-156 ’string*) 

(sdl-157 ’string’) 

(sdl-158 ’string’) 

(sd 1- 159 yes) 

(sd 1- 1 59 no) 

(sdl-159 unknown) 

(sdl-159 1) 

(sdl-160 yes) 

(sdl-160 no) 

(sdl-160 unknown) 

(sdl-160 1) 

(sdl-161 foo) 

(sdl-161 1) 

(sdl-161 2) 

(sdl-161 3) 

(sdl-162 foo) 

(sdl-162 1) 

(sdl-162 2) 

(sdl-162 3) 

(sdl-163 ’overflow’) 

(sd 1-164 input ’overflow’) 

(sd 1- 164 list ’yes* ’no* ’unknown" ’overflow" 
(sdl-165 12345.89) 

(patient-name paul) 

(patient-name brad) 


■inference’) 
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(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl - 
Csd 1 - 
(SDL- 
(SDL- 
(SDL- 
(SDL- 
(SDL- 
(SDL 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(SDL 
(SDL- 
(SDL- 
(SDL 
(SDL 
(SDL- 
(SDL- 
(SDL- 
(SDL 
(SDL 
(sdl 
(sdl 
(age 
(age 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl - 
(sdl- 
(sdl - 
(sdl- 
(sdl- 
(sdl- 
(sdl- 
(sdl - 
(sdl- 
(sdl- 
(sdl - 
(sdl- 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 
(sdl 


166 paul yes) 

166 paul 1 5) 

166 1.5 paul) 

166 yes paul) 

166 I think paul said yes) 
166 paul did say 1.5) 

166 1.5 says paul) 

166 yes says paul) 


168 

168 

168 

168 

168 

168 

169 

169 

169 

169 


167 YES FOR PAUL AND BRAD) 

167 YES FCR PAUL BRAD AND BILL) 

167 YES PAUL BRAD) 

167 PAUL YES BRAD) 

167 PAUL BRAD YES) 

167 PAUL BRAD 1 .5) 

167 1.5 BRAD PAUL MARK) 

167 BRAD AND PAUL SAY YES) 

167 BRAD SAYS YES AND SO DOES PAUL) 

168 YES FOR PAUL AND NO FOR BRAD AND MARK) 

NO says BRAD and YES says PAUL) 

NO for BRAD YES for PAUL) 

THE ANSWER FOR BRAD AND MARK IS NO and PAUL IS YES) 
BRAD MARK ARE NO AND PAUL IS YES TOO) 

THE ANSWER FOR BRAD AND MARK IS NO and PAUL IS 15) 
BRAD is unknown AND PAUL IS 1.5) 

NO says BRAD but not PAUL) 

NO for BRAD but not for PAUL) 

THE ANSWER FOR BRAD AND MARK IS NO but not PAUL) 
BRAD MARK ARE NO but not PAUL) 

-170 paul complains of vertigo and faintness) 

-170 brad has a headache) 
paul 30) 
brad 18) 

-172 major-complaint paul drowsiness) 

-172 recent-head-injury paul no) 

-172 confusion-mild paul yes) 

■172 major-complaint brad confusion) 

■172 major-complaint brad vertigo) 

■ 173 easel 450 550 3) 

■173 case2 440 560 2) 

173 case3 440 440 1) 

T74 easel dummy dummy dummy 450 dummy 550 dummy 3) 

174 case2 foo foo foo 440 foo 560 foo 2) 

174 case3 bar bar bar 440 bar 440 bar 1) 

175 pallet 5) 

175 pallet 4) 

175 options 1000 3000 4000 5024) 

175 case 3024) 

175 case 5000) 

175 case 5024) 

175 case 4000) 

-176 options 1000 3000 5000) 

-176 case 5000) 

177 options 1000 3000 4000) 

177 case 5000) 

-178 1) 

-179 options 1000 3000 5000) 

-179 case 5000) 

-180 options 1000 3000 4000) 

-180 case 5000) 

181 5000) 

181 6000) 

-182 'est* " ps t* ) 

-182 * ps t " "pst") 

182 'est' "est") 
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(sdl-182 "p st' ’est*) 
(sdl-183 2) 

(sdl-184 2) 

(sdl-185 ’string*) 
(sdl-186 ’string’) 
(sdl-186 ’foo*) 

(sdl-187 ’string’ ’foo") 
(sd 1 - 187 ’foo’ ’foo’) 
(sdl-188 ’foobar’) 

(sd 1 - 189 2) 

(sdl-190 i) 

(sdl-190 foo) 

(sdl-191 1) 

(sdl-191 0.1) 

(sdl-191 ’foo’) 

(sdl-191 bar) 

(sdl-191 2) 

(sdl-191 12345.6789) 
(sdl-191 ’fee*) 

(sdl-191 blee) 

(sdl-192 40) 

(sdl-192 50) 

(sdl-192 60) 

(sdl-192 70) 

(sdl-192 80) 

(sdl-192 90) 

(sdl-192 100) 


(detracts ini tial-2-sequences ” 

(sdl-115 ((to be) (foo bar) (to be))) 

(sdl-116 (a e i o u)) 

(sdl-117 (fluff mug bump bleet lollta)) 

; ; go hilclng or skiing 
(non-working (sdl-118)) 

(weather (sdl-118 major-blizzard)) 

(non-working (sdl-119)) 

(drive (sdl-119 two-wheel)) 

(non-working (sdl-120)) 

(weather (sdl-120 major-blizzard)) 

(drive (sdl-120 two-wheel)) 

(working (sdl-120 weekend)) 

, ; wild card 
(sdl-121 (one one)) 

(sd 1-122 (one one one)) 

(sdl-123 (654 5)) 

(sdl-124 (a r t h u r)) 

(sdl-125 (a rose Is a rose)) 

(sdl-126 (to be or not to be)) 

(sdl-127 (frank)) 

(sdl-128 (1 2)) 

(sdl-129 (love in bloom)) 

(sdl-130 (a rose is a rose)) 

, ; str_cat 
(sdl-131 (* foo’) ) 

(sdl-133 (first second)) 

(sdl-134 (republicans fox Jones nlxon williams harvey)) 
(sdl-134 (quakers pallas sanchez stone nlxon fregge)) 
(sdl-135 (yellow)) 

(sdl-135 (green)) 

(sdl-136 (yellow)) 

(sdl-136 (green)) 

(sdl-137 (yellow)) 
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(sdl-138 (green)) 

( sd 1-1 39 (-12 (12))) 

(sdl-140 (1 1)) 

(sdl-140 (1 2)) 

(sdl-141 (1 1)5 
(sdl-141 (1 2)) 

(sdl-142 (cold hot)) 

(sd 1- 143 (green yellow red blue white)) 
(sdl-144 (brother-cf waiter daniel)) 
(sdl-144 (child-of waiter david)) 
(sdl-144 (sex-of david male)) 

(sdl-144 (child-of waiter ;ane)) 
(sdl-144 (sex-of jane female)) 
(sdl-145-1 1st (red white blue)) 

(sdl-145 (red)) 

(sdl-145 (white)) 

(sdl-145 (blue)) 

(sdl- 1 46-seats (8 9 11 14 3)) 
(sdl-146-names (tom carol fred alex)) 
(sdl-147 (donors start fred)) 

(sdl-147 (donors fred John)) 

(sdl-147 (donors John mike)) 

(sdl-147 (donors milce finish)) 

(sdl-147 (donation fred 7.0)) 

(sdl-147 (donation John 10. 0)) 

(sdl-147 (donation mike 0.5)) 
(sdl-147-sum (donors start 0)) 

(sdl-148 (donor-list fred john mike)) 
(sdl-148 (donation fred 7.0)) 

(sdl-148 (donation john 10 0)) 

(sdl-148 (donation mike 0.5)) 
(sdl-148-sum (donors start 0)) 

(sdl-149 (inventory shirt-11 7.00)) 
(sdl-149 (inventory pants-9 10.00)) 
(sdl-149 (inventory belt-14 2.50)) 
(sdl-149 (current-sum 0)) 

(sdl-150 (Inventory shlrt-ll 7.00)) 
(sdl-150 (inventory pants-9 10.00)) 
(sdl-150 (inventory belt-14 2.50)) 
(sdl-150 (current-count 0)) 

(sdl-151 (quarter 10)) 

(sdl-151 (dime 8)) 

(sdl-151 (nickel 6)) 

(sdl-151 (penny 4)) 

(sdl-152 (quarter 10)) 

(sdl-152 (dime 8)) 

(sdl-152 (nickel 6)) 

(sdl-152 (penny 4)) 

(sdl-153 (yes)) 

(sdl-153 (no)) 

(sdl-153 (unknown)) 

(sdl-153 (1)) 

(sdl-154 (foo)) 

(sdl-154 (1)) 

(sdl-154 (2)) 

(sdl-154 (3)) 

(sdl- 155 (foo)) 

(sdl-155 (1)) 

(sdl-155 (2)) 

(sdl-155 (3)) 

(sdl- 156 (“string*)) 

(sdl- 1 57 ("string*)) 

(sdl-158 ("string*)) 

(sdl-159 (yes)) 
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(sdl-159 (no)) 
(sdl-159 (unknown)) 
(sdl-159 (1)) 
(sdl-160 (yes)) 
(sdl-160 (no)) 
(sdl-160 (unknown)) 
(sdl-160 (D) 
(sdl-161 (foo)) 
(sdl-151 (1)) 
(sdl-161 (2)) 
(sdl-161 (3)) 
(sdl-162 (foo)) 
(sdl-162 (1)) 
(sdl-162 (2)) 
(sdl-162 (3)) 


(sdl-163 ('overflow*)) 

(sdl-164 (Input "overflow*)) 

(sdl-164 (list "yes* "no" "unknown* "overflow" 'Inference*)) 
(sdl-165 (12345.89)) 


(patient-name (paul)) 

(patient-name (brad)) 

(sdl-166 (paul jes)) 

(sdl-166 (paul 1.5)) 

(sdl-166 (1.5 paul) ) 

(sdl-166 (yes paul)) 

(sdl-166 (I thin* paul said yes)) 

(sdl-166 (paul did say 1.5)) 

(sdl-166 (1.5 says paul)) 

(sdl-166 (yes says paul)) 

(SDL- 167 (YES FOR PAUL AND BRAD)) 

(SDL-167 (YES FOR PAUL BRAD AND BILL)) 

(SDL- 167 (YES PAUL BRAD)) 

(SDL-167 (PAUL YES BRAD)) 

(SDL-167 (PAUL BRAD YES)) 

(SDL-167 (PAUL BRAD 1.5)) 

(sdl-167 (1.5 BRAD PAUL MARK)) 

(sdl-167 (BRAD AND PAUL SAY YES)) 

(sdl-167 (BRAD SAYS YES AND SO DOES PAUL)) 

(sdl-160 (YES FOR PAUL AND NO FOR BRAD AND MARK)) 

(SDL- 168 (NO says BRAD and YES says PAUL)) 

(SDL- 168 (NO for BRAD YES for PAUL)) 

(SDL-168 (THE ANSWER FOR BRAD AND MARK IS NO and PAUL IS YES)) 

(SDL-168 (BRAD MARK ARE NO AND PAUL IS YES TOO)) 

(SDL-168 (THE ANSWER FOR BRAD AND MARK IS NO and PAUL IS 1.5)) 

(SDL-168 (BRAD is unknown AND PAUL IS 1.5)) 

(SDL- 169 (NO says BRAD but not PAUL)) 

(SDL-169 (NO for BRAD but not for PAUL)) 

(SDL-169 (THE ANSWER FOR BRAD AND MARK IS NO but not PAUL)) 
(SDL-169 (BRAD MARK ARE NO but not PAUL)) 

(sdl-170 (paul complains of vertigo and faintness)) 

(sdl-170 (brad has a headache)) 


(seq-age paul (30)) 

(seq-age brad (18)) 

(sdl-172 (major-complaint paul drowsiness)) 

(sdl-172 (receot-head-injury paul no)) 

(sdl-172 (confusion-mild paul yes)) 

(sdl-172 (major-complaint brad confusion)) 

(sdl-172 (major-complaint brad vertigo)) 

(sdl-173 (easel 450 550 3)) 

(sdl-173 (case2 440 560 2)) 

(sdl-173 (case3 440 440 1)) 

(sdl-174 (easel dummy dummy dummy 450 dummy 550 dummy 3)) 

(sdl-174 (case2 foo foo foo 440 foo 560 foo 2)) 


G.-ZL 
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(sdl-174 (case3 bar bar bar 440 bar 440 bar 1)) 
(sdl-175 (pallet 5)) 

(sdl-175 (pallet 4)) 

(sdl-175 (options 1000 3000 4000 5024)) 

(sdl-175 (case 3024)) 

(sdl-175 (case 5000)) 

(sdl-175 (case 5024)) 

(sdl-175 (case 4000)) 

(sdl-176 (options 1000 3000 5000)) 

(sdl-176 (case 5000)) 

(sdl-177 (options 1000 3000 4000)) 

(sdl-177 (case 5000)) 

(sdl-178 (1)) 

(sdl-179 (options 1000 3000 5000)) 

(sdl-179 (case 5000)) 

(sdl-180 (options 1000 3000 4000)) 

(sdl-180 (case 5000)) 

(sdl-181 (5000)) 

(sdl-181 (6000)) 

(sdl-182 ("est’ ’ ps t ’ ) ) 

(sdl-182 (“pst* * pst * ) ) 

(sdl-182 ("est’ ’ est*) ) 

(sdl-182 ( ’pst ’ ’est’)) 

(sdl-183 (2)) 

(sdl-184 (2)) 

(sdl-185 (’string’)) 

(sdl-186 ('string’)) 

(sdl-186 C’foo") ) 

(sdl-187 (’string* ’foo’)) 

(sdl-187 (’foo’ ’foo’)) 

(sdl-188 ( ’ foobar ’ ) ) 

(sdl-189 (2)) 

(sd 1-190 (1)) 

(sdl-190 (foo)) 

(sdl-191 (1)) 

(sdl-191 (0.1)) 

(sdl-191 ("foo")) 

(sdl-191 (bar)) 

(sdl-191 (2)) 

(sdl-191 (12345.6789) ) 

(sdl-191 (’fee’)) 

(sdl-191 (blee) ) 

(sdl- 192-seq (40)) 

(sdl- 192-seq (50)) 

(sdl-192-seq (60)) 

(sd 1 - 192-seq (70)) 

(sdl-192-seq (80)) 

(sdl- 192-seq (90)) 

(sdl-192-seq (100)) 

) 

(defrule print-fall 

(declare (salience -100)) 

(fail ?test-case) 

-> 

(printout t t ’ Runtime Error ■ ? test-case) ) 

(def rule sdl-rule-1 ’Match a literal symbol ■ 

(or (not (test-case sdl-1 TEST-CASE)) 

(not (test-case (sdl-1 TEST-CASE)))) 

=> 

(assert (fail sdl-1))) 

(def rule sdl-rule-2 "Match a literal string’ 
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Cor (not (test-case sdl-2 "a red flag")) 

(not (test-case (sdl-2 "a red flag*)))) 

= > 

(assert (rail sdl-2))) 

(def rule sdl-rule-3 'Match an integer* 

(or (not (test-case sdl-3 1)) 

(not (test-case (sdl-3 1)))) 

-> 

(assert (fail sdl-3))) 

(def rule sdl-rule-4 "Don't match a float that is almost equal" 
(or (test-case sdl-4 100.3) 

(test-case (sdl-4 (100.3)))) 

= > 

(assert (fail sdl-4))) 

(def rule sdl-rule-5 "Don’t let ? match nothing" 

(or (test-case sdl-5 ?) 

(test-case (sdl-5 7 ))) 

-> 

(assert (fail sdl-5))) 

(defrule sdl-rule-6 ■? must match a symbol" 

(or (not (test-case sdl-6 ?)) 

(not (test-case (sdl-6 ?)))) 

-> 

(assert (fail sdl-6))) 

(defrule sdl-rule-7 " 7 must match a string" 

(or (not (test-case sdl-7 ?)) 

(not (test-case sdl-7 ( ? )))) 

r > 

(assert (fall sdl-7))) 

(defrule sdl-rule-8 "? must not match TWO symbols" 

(or (test-case sdl-8 ?) 

(test-case (sdl-8 ?))) 

- > 

(assert (fail sdl-8))) 

(defrule sdl-rule-9 "$ 7 must match nothing" 

(or (not (test-case sdl-9 $?)) 

(not (test-case sdl-9 ($?)))) 

- > 

(assert (fall sdl-9))) 

(defrule sdl-rule-10 "$? must match a single symbol" 

(or, (not (test-case sdl-10 $?)) 

(not (test-case sdl-10 ($?)))) 

_> 

(assert (fail sdl-10))) 

(defrule sdl-rule-U *$? must match a single string" 

(or (not (test-case sdl-ll S?)) 

(not (test-case sdl-ll ($?)))) 

= > 

(assert (fail sdl-ll))) 

(defrule sdl-rule-12 "$ 7 must match two symbols" 

(or (not (test-case sdl-12 $?)) 

(not (test-case (sdl-12 $?)))) 

-> 

(assert (fail sdl-12))) 
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(defrule sdl-rule-13 matches symbol, $ 7 matches nothing* 
(or (not (sdl-13 7 $ 7 )) 

(not (sdl-13 (?) $?))) 

=> 

(assert (fall sdl-13))) 

(defrule sdl-rule-14 ■? and $? each match a single symbol" 
(or (not (sdl-H 7 $?)) 

(not C sd 1 — 14 (? ($ 7 ))))) 

-> 

(assert (fail sdl-14))) 


(defrule sdl-rule-15 ■? matches symbol, $? matches string* 
(or (not (sd 1-15 ? $ 7 )) 

(not (sdl-15 ( 7 ($?))))) 

=> 

(assert (fail sdl-15))) 


(defrule sdl-rule-16 *? matches 
(or (not (sdl-16 ? $ 7 )) 

(not (sdl-16 (? ($?))))) 

=> 

(assert (fall sdl-16))) 

(defrule sdl-rule-17 •$? matches 
(or (not (sdl-17 $ 7 7 )) 

(not (sdl-17 $? (?)))) 

=> 

(assert (fail sdl-17))) 

(defrule sdl-rule-18 -$ 7 matches 
(or (not (sdl-18 S? ?)) 

(not (sdl-18 ($ 7 ?)))) 

-> 

(assert (fail sdl-18))) 

(defrule sdl-rule-19 "$ 7 matches 
(or (not (sdl-19 $? 7 )) 

(not (sdl-19 ($ 7 7 )))) 

=> 

(assert (fail sdl-19))) 

(defrule sdl-rule-20 “$? matches 
(or (not (sd 1-20 $? ?)) 

(not (sd 1 -20 ($? (?))))) 

= > 

(assert (fail sdl-20))) 


e symbol, $ 7 matches tvo symbols - 


nothing; ? matches symbol - 


symbol , 7 matches symbol - 


symbol; 7 matches strlng" 


tvo symbols; ? matches one symbol - 


(defrule sdl-rule-21 
(or (not (sdl-21 $ 7 
sdl-21 
$ ? )) 

(not (sdl-21 ($ 7 
sdl-21 

$?)))) 

=> 

(assert (fail sdl-21))) 

(defrule sdl-rule-22 
(or (not (sd 1 -22 $ 7 
sdl-22 
$ 7 )) 

(not (sdl-22 ($ 7 
sdl-22 


.matches nothing 


.matches nothing 
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$?)))) 

= > 

(assert (fa.il sdl-22))) 

(defrule sdl-rule-23 ■* 

(or (not (sdl-23 $ 7 
sd 1 -23 
$ 7 )) 

(not (sdl-23 ($? 

sdl-23 

$ 7 )))) 

=> 

(assert (fail sdl-23))) 

(defrule sdl-ru'le-24 
(or (not (sd 1 -24 

sd 1-24 

$?)) 

(not (sdl-24 ($? 

sdl-24 

$?)))) 

=> 

(assert (fail sdl-24))) 

(defrule sdl-rule-25 '* 
(or (not (sdl-25 $ ? 

sd 1 -25 
$?)* 

(not (sdl-25 ($? 

sdl-25 

$?)))) 

-> 

(assert (fail sdl-25))) 

(defrule sdl-rule-26 M 
(or (not (sdl-26 7 x 
fun 
’x)) 

(not (sdl-26 ( 7 x 
fun 

7 x)))) 


(assert (fail sdl-26))) 


(defrule sdl-rule-27 
(or (sdl-27 ? x 
fun 
?x) 

(sdl-27 ( 7 x 
fun 
?x) ) ) 

=> 

(assert (fall sdl-27))) 

(defrule sdl-rule-28 ■■ 
(or (sdl-28 ? x 
fun 
*>x) 

(sdl-28 ( ? x 
fun 
?x))) 


(assert (fall sdl-28))) 


;matches red 


;matches nothing 


; matches sdl-25 data 


, matches blue 


.matches blue 


;matches blue 


.matches blue 
idoes not match blue 

.matches blue 
.does not match blue 
.matches blue 
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(defrule sdl-rule-29 - " 

Cor (sdl-29 7 x 
fun 
7 x) 

(sdl-29 (’x 
fun 

C’x)))) 

= > 

(assert (fall sdl-29))) 

(defrule sdl-rule-30 ■ ■ 

(sdl-30 red $ 9 x) 

(sdl-30 (red ($?x))) matches 

(sdl-30 purple $ ? x) 

(sdl-30 (purple ($ ? x))) 

=> 

(assert (success sdl-30)) 

(assert (success (sdl-30)))) 

(defrule sdl-rul e-30-2 
(declare (salience -1)) 

(or (not (success sdl-30)) 

(not (success (sdl-30)))) 

=> 

(assert (fall sdl-30))) 

(defrule sdl-rule-31 
(sdl-31 red $?x)- 
(sdl-31 (red $?x)) 

(sdl-31 purple $ 7 x) 

(sdl-31 (purple $?x)) 

-> 

(assert (fail sdl-31))) 

(defrule sdl-rule-32 ■■ 

(sdl-32 'red) 

(sdl-32 (“red) ) 

=> 

(assert (fall sdl-32))) 

(defrule sdl-rule-33 ■■ 

(or (not (sdl-33 "red)) 

(not (sdl-33 ("red)))) 

=> 

(assert (fail sdl-33))) 


.matches blue 

.matches blue 
, matches 'blue ■ 

blue green 

.matches blue green 

.matches blue green 

;bdc added 02/04/88 


.matches blue green 
;matches blue brown (no match) 

.matches red (no match) 

.matches gree 
.matches green 


(defrule sdl-rule-34 11 

(or (not (sdl-34 redlblue)) 

(not (sdl~34 (redlblue)))) .matches red 

=> 

(assert (fall sdl-34))) 


(defrule sdl-rule-35 " 

(or (not (sdl-35 redlblue)) .matches blue 

(not (sdl-35 (redlblue)))) 

= > 

(assert (fail sdl-35))) 

(defrule sdl-rule-36 ■■ 

(sdl-36 redlblue) 

(sdl-36 (redlblue)) .matches green (no match) 

-> 

(assert (fail sdl-36))) 
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(defrule sdl-rule-37 ,B 
(sdl-37 “redi“blue) 

(sdl-37 (“redi“blue) ) 

= > 

(assert (fail sdl-37))) 

(de f rule sdl-rule-38 M 
(sdl-38 “redi"blue) 

(sdl-38 (“redfblue) ) 

=> 

(assert (fail sdl-38))) 

(defrule sdl-rule-39 ■■ 

(or (not (sdl-39 “redi"blue)) .matches green 

(not (sdl-39 (“redi'blue)))) 

-> 

(assert (fall sdl-39))) 

(defrule sdl-rule-40 

(sdl-40 “rediblue I get) patches red (no match) 

(sdl-40 (“rediblue I get) ) 

=> 

(assert (fall sdl-40))) 


(defrule sdl-rule-41 ■* 

(or (not (sdl-41 “rediblue I get) ) 

(not (sdl-41 (“rediblue I get) ) ) ) .matches blue 

=> 

(assert (fall sdl-41))) 

(defrule sdl-rule-42 ■* 

(or (not (sdl-42 “rediblue I get) ) 

(not (sdl-42 (“rediblue I get) ) ) ) .matches get 

=> 

(assert (fall sdl-42))) 

(defrule sdl-rule-43 

(sdl-43 “rediblue t get) .matches green (no match) 

(sdl-43 (“rediblue Iget) ) 

=> 

(assert (fail sdl-43))) 

(defrule sdl-rule-44 

(sdl-44 ’xi'red) .matches red (no match) 

(sdl-44 (?xi“red) ) 

= > 

(assert (fail sdl-44))) 

(defrule sdl-rule-45 11 
(or (not (sdl-45 ?xi“red)) 

(not (sdl-45 (?xi“red)))) 

=> 

(assert (fail sdl-45))) 

(defrule sdl-rule-46 ■■ 

(or (not (sdl-46 ? xired I blue) 

(not (sdl-46 (?xired I blue 

=> 

(assert (fail sdl-46))) 

(defrule sdl-rule-47 M 

(or (not (sd 1-47 7 xired I blue) 

(not (sdl-47 (?xiredlblu€ 


.matches green 


) 

0 ))) 


.matches red 


>) 

>)))) 


.matches blue 


.matches red (no match) 


;matches blue (no match) 
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(assert (fail sdl-47))) 

(defrule sdl-rule-48 *■ 

(sdl-48 7 xlred!blue) 

(sdl-48 ( 7 xAred I blue) ) 

=> 

(assert (fail sdl-48))) 

(defrule sdl-ruie-49 
(sdl-49 a 7 x) 

(sdl-49 (a (?x))) 

(sdl-49 b 7 x£~red) 

(sdl-49 (b (?xt“ red))) 

=> 

(assert (fail sdl-49))) 

(defrule sdl-rule-50 
Csdl-50 a 7 x) 

(sdl-50 (a (?x) )) 

(sdl-50 b 7 x4"red) 

(sdl-50 (b ( 7 x4'red))) 

=> 

(assert (fail sdl-50))) 

(defrule sdl-rule-51 ■■ 

(sdl-51 a ?x) 

(sdl-51 (a (?x))) 

(sdl-51 b 7 xA'red) 

(sdl-51 (b ( 7 x*-red))) 

-> 

(assert (success sdl-51)) 

(assert (success (sdl-51)))) 

(defrule sdl-rule-51-1 *chec)c on sdl-rule-51* 
(declare (salience -1)) 

(or (not (success sdl-51)) 

(not (success (sdl-51)))) 

=> 

(assert (fail sdl-51))) 


(defrule sdl-rule-52 ■■ 

(sdl-52 a 7 x) 

(sdl-52 (a ( 7 x) ) ) 

(sdl-52 b 7 xXred I blue) 

(sdl-52 (b ( 7 x*red I blue) ) ) 

-> 

(assert (success sdl-52)) 
(assert (success (sdl-52)))) 

(defrule sdl-ru le-52-1 *■ 
(declare (salience -l)) 

(or (not (success sdl-52)) 
(not (success (sdl-52)))) 

=> 

(assert (fail sdl-52))) 

(defrule sdl-rule-53 ■■ 

(sd 1-53 a ( 7 x)) 

(sdl-53 (a 7 x) ) 

(sdl-53 b 7 x*red!blue) 

(sdl-53 (b ( 7 x*red I blue) ) ) 


FINAL REPORT 


patches green (no match) 

.matches red 
.matches red (no match) 

;matches red 

imatches green (no match) 

;matches blue 
.matches blue 

.added by BDC 02/04 


;matches red 
.matched red 

.added by BDC 02/04 

;matches red 
matches blue (no match) 
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= > 

(assert (fail sdl-53))) 

(defrule sdl-rule-54 

(sdl-54 a ?x) ; matches green 

(sdl-54 (a (?x))) 

(sdl-53 b 7 x*red|blue) 

(sdl-54 (b ( 9 x4red 1 blue) ) ) imatches green (no matcn) 

-> 

(assert (fail sdl-54))) 

(defrule sdl-rule-55 

(or (not (sdl-55 7 x* : (numberp 9 x))) .matches 2 

(not (sdl-55 (?xt: (numberp 9 x))))) 

-> 

(assert (fall sdl-55))) 

(defrule sdl-rule-56 

(or (sdl-56 ?x4 : (numberp 9 x)) patches red (no match) 

(sdl-56 ( ? x* : (numberp 9 x)))) 

= > 

(assert (fall sdl-56))) 

(defrule sdl-rule-57 ■■ 

(or (sdl-57 9 x*: (numberp ?x)i:(oddp ?x) ) .matches 2 (no match) 

(sdl-57 (?x* ; (numberp 9 x)*: (oddp 9 x)))) 

= > 

(assert (fail sdl'-57))) 

(defrule sdl-rule-58 11 

(or (sdl-58 ?xk: (stringp ?x) ) .matches 2 (no match) 

(sdl-58 ( 9 x* : (stringp 9 x)))) 

=> 

(assert (fail sdl-58))) 

(defrule sdl-rule-59 ■■ 

(or (not (sdl-59 7 xk (stringp ?x))) patches Ted 1 

(not (sdl-59 ( 9 x*: (stringp 9 x))))) 

-> 

(assert (fall sdl-59))) 

(defrule sdl-rule-60 ■■ 

(or (not (sdl-60 = (+ 1 1))) .matches 2 

(not (sdl-60 (=(♦ 1 1))))) 

=> 

(assert (fail sdl-60))) 

(defrule sdl-rule-6l 
(or (sdl-61 =(+ 1 D) 

(sdl-61 <=(+ 1 1)))) .matches "red* (no match) 

=> 

(assert (fail sdl-61))) 

(defrule sdl-rule-62 11 

(or (sdl-62 =(strlng-append "re" *d")) ;matches 2 (no match) 

(sdl-62 (= (string-append "re* "d*)))) 

=> 

(assert (fall sdl-62))) 

(defrule sdl-rule-63 ■■ 

(or (not (sd 1-63 = (string-append “re* *d"))) ;matches *red“ 

(not (sdl-63 (= (string-append “re* *d*))))) 

=> 

(assert (fail sdl-63))) 
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(defrule sdl-rule-64 ■■ 

Csdl-64 ?y) 

Csdl-64 7 x*=(* 5 ?y)j = (- 12 ?y) ) 

=> 

(assert (success sdl-64))) 

(defrule sd 1 -ru 1 e-64-seq 
(sdl-64-seq ( 7 y)) 

(sdl-64 -seq ( 7 x*=(+ 5 7 y)|=(- 12 ?y) ) ) 

= > 

(assert (success sdl-64-seq) ) ) 

(defrule sdl-rule-64-2 • • 

(declare (salience -1)) 

(or (not (success sdl-64)) 

(not (success sdl-64-seq) ) ) 

-> 

(assert (fail sdl-64))) 


4499 
4 g 4 g 

nil t nil nil 


nil 


4499 
4 9 4 9 

t nil nil 


, added by BDC 02/04 


(defrule sdl-rule-65 
(sdl-65 data 7 x) 

(sdl-65 (data 7 x)) 

(sdl-65 value ?y) 

(sdl-65 (value 7 y)) 

(test (>= (- ?y 7 x) 3)) 

r > 

(assert (success sdl-65)) 
(assert (success (sdl-65)))) 

(defrule sdl-ru 1 e-65-2 ■■ 
(declare (salience -l)) 

(or (not (success sdl-65)) 
(not (success (sdl-65)))) 

- > 

(assert (fail sdl-65))) 


.matches 6 
.matches 9 
, succeeds 

.added by BDC 02/04 



(defrule sdl-rule-66 •• 





(sdl-66 7 a ?x 1 ?y 1 ) 
(sdl-66 (?a 7 x 1 ? y 1 ) ) 

0 

N 

O 

cr 

2 5.0 9 

— 

(sdl-66 ?bi“ 7 a ?x2 7 y2) 
(sdl-66 ( 7 b4~ 7 a 7 x2 7 y2)) 

0 

0 

or 

2 5.0 9 


(test (< 0 (/ (- ?y2 ?y 1 ) 

, succeeds 




(- 7 x2 7 xl)))) 


(assert (success sdl-66)) 
(assert (success (sdl-66)))) 


(defrule sdl-rule-66-2 •* 

(declare (salience -l)) 

(or (not (success sdl-66)) 

(not (success (sdl-66)))) 

-> 

(assert (fail sdl-66))) 

(defrule sdl-rule-67 ■ ■ 

(sdl-67 datal ?y) 

(sd 1-67 (datal (?y))) 

(sdl-67 data2 7 x*:(> ?x ?y) ) 
(sdl-67 (data2 ( 7 x£:(> ?y)))) 

= > 

(assert (success sdl-67)) 

(assert (success (sdl-67)))) 


.added by BDC 02/04 


;matches 3 
matches 5 
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(def rule sdl-rule-67-2 
(declare (salience -1)) 

(or (not (success sdl-67)) 

(not (success (sdl-67)))) 

-> 

(assert (fall sdl-67))) 

(def rule sdl-rule-68 " 

(sdl-68 datai 7 y) 

(sdl-68 (datai ( 7 y))) 

(sdl-68 data2 ?x*:(> 9 x 7 y)) 
(sdl-68 (data2 (?xft:(> ? x 9 y)))) 

-> 

(assert (fall sdl-68))) 

(defrule sdl-rule-69 " 

(sdl-69 datai ?y) 

(sdl-69 (datai ( ? y))) 

(sdl-69 data2 7 xft:(= 9 y 9 x)) 
(sdl-69 (data2 ( 7 xft: (= 7 y 9 x)))) 

= > 

(assert (success sdl-69)) 

(assert (success (sdl-69)))) 

(defrule sdl-rule-69-2 
(declare (salience -1)) 

(or (not (success sdl-69)) 

(not (success (sdl-69)))) 

=> 

(assert (fall sdl-69))) 


; added by BDC 02/04 


;matches 9 

.matches 5 (no match) 


;matches 4 
; matches 4 


; added by BDC 02/04 


(defrule sdl-rule-70 

(sdl-70 datai ^ y* : (numberp ?y)) ;matches red (no match) 

(sdl-70 (datai 7 yft: (numberp ?y))) 

(sdl-70 data2 ?xft: (numberp 9 x) ft : (= ?x ?y)) ;matches 5 
(sdl-70 (data2 7 xft: (numberp ?x) ft : (= 9 x ?y))) 

=> 

(assert (fall sdl-70))) 


(defrule sdl-rule-71 •• 

(sdl-71 datai ?yft: (numberp 9 y)) 

(sdl-7l (datai 7 yft: (numberp ?y))) 

(sdl-71 data2 ?xft: (numberp 9 x)ft:(= ? y 9 x)) 

(sdl-71 (data2 7 xft: (numberp ?x)ft:(= 7 y 9 x))) 

= > 

(assert (fall sdl-71))) 

(defrule sdl-rule-72 " , ^ 

(sdl-72 datai 7 y«: (numberp 9 y)) patches red (no match) 

(sdl-72 data2 7 xft : (numberp ?x)ft(= 7 x 9 y)) ;matches 5 

(sdl-72 (datai ?yft: (numberp 7 y))) .matches red (no match) 

(sdl-72 (data2 7 xft (numberp ?x)ft:(= ?x ?y))) 

-> 

(assert (fall sdl-72))) 

(defrule sdl-rule-73 ■■ 

(sdl-73 datai ?y) 

(sdl-73 data2 7 xft:(eq ?x ?y)) 

(sdl-73 (datai ?y)) 

(sdl-73 (data2 7 xft:(eq 7 x ?y))) 

-> 

(assert (fall sdl-73))) 

(defrule sdl-rule-74 •• 


;matches red 

; matches 5 (no match) 
.matches red 


.matches a 4* (no match) 
.matches 5 
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(sdl-74) 

(sdl-74 0) 

-> 

(assert (fall sdl-74)) 

(assert (fall (sdl-74)))) 

(defrule sd 1 -ru 1 e-74-2 "• 

’tempi <- (fail sdl-74) 

? temp2 <- (fail (sdl-74)) 

= > 

(retract 7 templ ?temp2)) 

(defrule sdl-rule-75 "" 

(sd 1 -75) 

(sd 1 -75 ()) 

-> 

(assert (sdl-75 1 =(gentemp))) 

(assert (sdl-75 2 = (gen temp) ) ) 

(assert (sdl-75 (1 = (gentemp) ) ) ) 
(assert (sdl-75 (2 = (gentemp) ) ) ) ) 

(defrule sdl -ru le-75-2 11 
9 tempi <- (sdl-75 i ?) 

7 temp2 <- (sdl-75 (1 ?)) 

? temp3 <- (sdl-75 2 ?) 

?temp4 <- (sdl-75 (2 ?)) 

=> 

(retract 7 templ ?temp2 ?temp3 7 temp4)) 

(defrule sdl-rule-75-3 *• 

(declare (salience -10)) 

(or (sdl-75 ? ?) 

(sdl-75 ( 7 7 ))) 

= > 

(assert (fail sdl-75))) 

, ; (defrule sdl-rule-76 ■■ 

; . (sdl-76) 

; => 

(assert ("sdl-76 temp"))) 

, Was (string_assert "sdl-76 temp") 


;matches sdl-74 

.asserts fail fact 

.matches fail fact 
;matches fail fact 

.retracts fail fact 
;matches sdl-75 
.asserts temp facts 


;matches temp facts 

;retracts temp facts 
;matches (sdl-75) (no match) 

;matches (sdl-76) 

; asserts temp fact 


added by BDC 02/04 

.matches temp fact 


, (defrule sdl-rule-77 •• 

.. (sd 1 -77) 

; ; -> 

(assert ("sdl-77 \"temp\""))) 

., Was (string_assert "sdl-77 \"temp\"") 

; , (defrule sd 1 -ru 1 e-77-2 •• 

. ; (declare (salience -1)) ;added by BDC 02/04 

;; (not ("sdl-77 \"temp\"")) ;matches temp fact 

; => 

(assert (fail sdl-77))) 

(defrule sdl-rule-78 


; matches (sdl-77) 

.asserts temp fact 


(defrule sd 1 -rul e-76-2 11 
(declare (salience -1)) 
(not ("sdl-76 temp")) 

=> 

(assert (fail sdl-76))) 
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(sdl-78) 

(sdl-78 O) 

(sdl-78 1 7 x) 

(sdl-78 (1 7 x)) 

(sdl-78 2 7 y) 

(sdl-78 (2 ?y) ) 

= > 

(bind 7 a (+ 7 x 7 y)) 
(assert (sdl-78 3 7 a))) 

(defrule sdl-rule-78-2 
(declare (salience -1)) 
(not (sdl-78 3 13)) 

-> 

(assert (fail sdl-78))) 


.matches (sdl-78) 

.matches 5 
.matches 8 

;binds 7 a to 13 
.asserts (sdl-78 3 13) 

.added by BDC 02/04 
.matches temp fact from above 


(defrule sdl-rule-79 ■■ 

(sdl-79 $?data) ;matches a b c d e f g 

(sdl-79 ($?data) ) 

= > 

(assert (sdl-79 length =(length$ ?data))) ; asserts 7 

(assert (sdl-79 (length =(length$ 7 data))))) 


(defrule sdl-rule-79-2 •• 

(or (not (sdl-79 length 7)) ;matches 7 fact from above 

(not (sdl-79 (length 7)))) 

=> 

(assert (fail sdl-79))) 

(defrule sdl-rule-80 ■■ 

(sdl-80 S?data) .matches a b c d e f g 

(sdl-80 (*?data) ) 

=> 

(assert (sdl-00 second =(nth$ ?data 2))) ; asserts b 

(assert (sdl-80 (second =(nth$ ?data 2))))) 


(defrule sdl-rule-80-2 *• 

(or (not (sdl-80 second b)) 

(not (sdl-80 (second b)))) 

= > 

(assert (fail sdl-80))) 

(defrule sdl-rule-81 ■■ 

(sdl-81 $?datal) 

(sdl-81 ($?data2) ) 

r > 

(bind ?al (positions b ?datal)) 

(bind ?a2 (positions b ?data2)) 

(assert (temp sdl-81 position ?al)) 
(assert (temp sdl-81 (position ?a2)))) 

(defrule sdl-rule-81-2 ■* 

(or (not (temp sdl-81 position 2)) 

(not (temp sdl-81 (position 2)))) 

=> 

(assert (fail sdl-81))) 

(defrule sdl-rule-108 M 
(sdl-108 7 x) 

(sdl-108 ( 7 x)) 

=> 

(if (= 7 x 10) 


; matches b fact from above 


.matches a b c d e f g 


; binds ?a to 2 
; binds ^a to 2 
asserts 2 


; matches 2 fact from above 


.matches 10 

.matches 10 
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then 

(assert (success sdl-108)) 
else 

(assert (fall sdl-108)))) 

(defrule sdl-rule-109 
(sdl-109 ?y) 

Csdl-109 (?y) ) 

=> 

(bind ’x 9 y) 

(vhile (> 0) do 

(assert (sdl-109 while ?x) 

(sdl-109 (while 7 x))) 
(bind ?x (- 1)))) 

(defrule sdl-rule-109-2 ■■ 

(sdl-109 vhile 3) 

(sdl-109 while 2) 

(sdl-109 (vhile D) 

(sdl-109 (vhile 3)) 

(sdl-109 (vhile 2)) 

(sdl-109 (vhile i)) 

=> 

(assert (success sdl-109))) 

(defrule sdl-rul e-109-3 ■■ 

(declare (salience -1)) 

(not (success sdl-109)) 

-> 

(assert (fail sdl-109))) 

(defrule sdl-rule-115 •• 

(sdl-115 $?x foo bar $ 7 x) 

(sdl-115 (($?x) (foo bar) ($?x))) 

=> 

(assert (success sdl-115))) 

(defrule sdl-rule-115-l 
(declare (salience -10)) 

(not (success sdl-115)) 
r> 

(assert (fail sdl-115))) 

(defrule sdl-rule-116 ■■ 

(or (not (sdl-116 $?TOvels u)) 

(not (sdl-116 d?vovels u)))) 

=> 

(assert (fall sdl-116))) 

(defrule sdl-rule-117 •• 

(sd 1-1 17 $?a $?b) 

(sdl-117 ($?a $?b) ) 

=> 

(assert (sdl-117-a $?a) ) 

(assert (sdl-117-b $?b)) 

(assert (sdl-117-a ($?a))) 

(assert (sdl-117-b ($?b)))) 

(defrule sdl-rul e-117-1 ■■ 

(sdl-117-a) 

(sdl-117-a fluff) 

(sdl-117-a fluff mug) 

(sdl-117-a fluff mug bump) 

(sdl-117-a fluff mug bump bleet) 


.matches 3 

;raatches 3 


.three facts from previous rule 


.three facts from previous rule 


; added by BDC 02/05/88 


.(sdl-115 to be foo bar to be) 

; (sdl-115 to be foo bar to be) 


.previous rule 


; (sdl-l 16 a e i o u) 


.(sdl-117 fluff mug bump bleet lolita) 
.(sdl-117 fluff mug bump bleet lolita) 


should 

be 

six 

pairs 

of 

facts 

should 

be 

six 

pairs 

of 

facts 
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(sdl-117-a fluff mug bump bleet lollta) 
(sdl-117-b fluff mug bump bleet lollta) 
(sdl-117-b mug bump bleet lollta) 
(sdl-117-b bump bleet lollta) 

(sdl-117-b bleet lollta) 

(sdl-1 17-b lollta) 

(sdl-117-b) 

Csdl - l 17-a ()) 

(sdl - 1 17-a (fluff)) 


(sdl-1 17-a 
(sdl-1 17-a 
(sdl-1 17-a 
(sdl-1 17-a 
(sdl-1 17-b 
(sdl-1 17-b 
(sdl-1 17-b 
(sdl-1 17-b 
(sdl-117-b 
(sdl-1 17-b 


(fluff mug)) 

(fluff mug bump)) 

(fluff mug bump bleet)) 

(fluff mug bump bleet lollta)) 

(fluff mug bump bleet lollta)) 

(mug bump bleet lollta)) 

(bump bleet lollta)) 

(bleet lollta)) 

(lollta)) 

0 ) 


=> 

(assert (success sdl-117))) 


, s ix pairs 


; another six pairs 


(defrule sdl-rule-1 17-2 *• 

(declare (salience -10)) 

(not (success sdl-117)) 

=> 

(assert (fail sdl-117))) 

(defrule sdl-rule-slcl-1 •• 

(non-wor)cing 7 date) 

(non-working (?date)) 

(and (not (weather 7 date hot-and-humid)) 
(not (weather ?date major-blizzard)) 
(not (traffic 7 date massive)) 

(not (weather (?date hot-and-humid))) 
(not (weather ( 7 date major-blizzard))) 
(not (traffic ( 7 date massive)))) 

-> 

(assert (go-hiking 7 date)) 

(assert (go-hiking ( 7 date)))) 


;from previous rule 


; (non-working sdl-118) (non-working sdl-119) 

; (non-working sdl-118) (non-working sdl-119) 

; no match 

; (weather sdl-118 major-blizzard), no match 119 
; no match 

; (weather sdl-118 major-blizzard), no match 119 
; no match 

;no 118; yes 119 
, no 118; yes 119 


(defrule sdl-rule-skl-2 •• 

(non-working 7 date) 

(non-working (?date)) 

(or (not (weather 7 date major-blizzard)) 
(not (drive ?date two-wheel)) 

(not (working ?date weekend)) 

(not (weather ( 7 date major-blizzard))) 
(not (drive (?date two-wheel))) 

(not (working (?date weekend)))) 

=> 

(assert (go-skiing 7 date)) 

(assert (go-skiing ( 7 date)))) 

(defrule sdl-rule-118 ■■ 

(or 

(go-hiking sdl-118) 

(not (go-skling sdl-118)) 

(go-hiking (sdl-118)) 

(not (go-skllng (sdl-118)))) 

=> 

(assert (fail sdl-118))) 


; (non-working sdl-119) 

; (non-working sdl-119) 

,no match for 119. yes for 118 
, (drive sdl-119 two-wheel), no for 118 

.no match for 119, yes for 118 
; (drive sdl-119 two-wheel), no for 118 
; no match 

, 119 yes, 1 18 yes 
,119 yes , 1 18 yes 


; f rora above rules 
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(defrule sdl-rule-119 •• 

(or 

(not (go-hiking sdl-119)) 
(not (go-skling sdl-119)) 
(not (go-hiking (sdl-119))) 
(not (go-skiing (sdl-119)))) 


(assert, (fail sdl-119))) 

(defrule sd 1 -rule- 120 ■■ 

(or 

(go-hiking sdl-120) 
(go-skiing sdl-120) 
(go-hiking (sdl-120)) 
(go-skiing (sdl-120))) 

=> 

(assert (fail sdl-120))) 

(defrule sdl-rule-121 
(sdl-121 $ 7 7 x $ 7 7 x $?) 
(sdl-121 ($? ? x $? ? x $?)) 

=> 

(assert (match sdl-121 7 x))) 

(defrule sdl-rule-121-2 ■■ 
(declare (salience -1)) 

(not (match sdl-121 one)) 

= > 

(assert (fail sdl-121))) 


(defrule sdl-rule-122 
(sd 1- 1 22 $? 7 x $ 7 ? x S 7 ) 
(sdl-122 ($? 7 x $ 7 7 x $?)) 

= > 

(assert (match sdl-122 7 x))) 

(defrule sdl-rul e-122-2 ■■ 
(declare (salience -1)) 

(not (match sdl-122 one)) 

-> 

(assert (fail sdl-122))) 

(defrule sdl-rule-123 *■ 
(sdl-123 $? ? x $? ?x $ 7 ) 
(sdl-123 ($ 7 7 x $ 7 ?x $ 7 )) 

= > 

(assert (match sdl-123 ?x))) 

(defrule sdl-rule- 123-2 
(declare (salience -1)) 

(not (match sdl-123 5)) 

-> 

(assert (fail sdl-123))) 

(defrule sdl-rule-124 ■■ 
(sdl-124 $ 7 7 x $? 7 x $ 7 ) 
(sdl-124 ($ 7 7 x $ 7 7 x $?)) 

z > 

(assert (match sdl-124 ?x))) 

(defrule sdl-rule- 124-2 •• 
(declare (salience -1)) 

(not (match sdl-124 r) ) 


, from above rules 
; f rom above rules 


, (sdl-121 one one) 
; (sdl-121 one one) 


; added by BDC 02/05/88 


; (sdl-122 one one one) 
.(sdl-122 one one one) 


; added by BDC 02/05/88 


; (sdl-123 6545) 
. (sdl-123 6545) 


.added by BDC 02/05/88 


, (sdl-124 a r t h u r) 
; (sdl-124 a r t h u r) 


added by BDC 02/05/88 
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(assert, (fall sdl-124))) 

(defrule sdl-rule-125 
(sdl-125 $ 7 7 x $ 7 7 x S?) 
(sdl-125 ($ 7 7 x $ 7 ? x $?)) 

=> 

(assert (match sdl-125 7 x))) 

(defrule sdl-ru 1 e- 125-2 
(declare (salience -1)) 

(or (not (match sdl-125 a)) 

(not (match sdl-125 rose))) 
r> 

(assert (fall sdl-125))) 


; (sdl-125 a rose Is a rose) 

; (sdl-125 a rose is a rose) 

; should get two asserted facts 
, added by BDC 02/05/88 


(defrule sdl-rule-126 11 

(or (not (sdl-126 $ 7 x or not $?x)) 

(not (sdl-126 ($?x or not $ 7 x)))) 

= > 

(assert (fall sdl-126))) 

(defrule sdl-ru le- 1 27-master 
(sdl-127 ? $?x) 

(sdl-127 (? $?x)) 

=> 

(assert (sd 1- 127-result $ 7 x)) 

(assert (sdl-127-result ($ 7 x)))) 

(defrule sdl-rule-127 •• 

(or (not (sdl-127-result) ) 

(not (sdl- 127-result ()))) 

=> 

(assert (fail sdl-127))) 

(defrule sdl-ru le- 128-master ■■ 

(sdl- 128 ? $?x) 

(sdl-128 ( 7 $ 7 x)) 

— > 

(assert (sdl-128-result $ 7 x)) 

(assert (sd 1- 128-result ($?x)))) 

(defrule sdl-rule-128 " 

(declare (salience -1)) 

(or (not (sdl-128-result 2)) 

(not (sdl-128-result (2)))) 

=> 

(assert (fall sdl-128))) 

(defrule sdl-rule-129-master 
(sdl-129 7 $ 7 x) 

(sdl-129 (? $?x)) 

=> 

(assert (sdl -129-result $?x)) 

(assert (sd 1- 129-result ($?x)))) 

(defrule sdl-rule-129 *• 

(declare (salience -1)) 

(or (not (sdl-129-result in bloom)) 

(not (sdl-129-result (in bloom)))) 

= > 

(assert (fail sdl-129))) 

(defrule sdl-rule- 130-master 


; (sdl-126 to be or not to be) 


, (sdl-127 frank) 
; (sdl-127 frank) 


;should be no fact of this type 


; (sdl-128 1 2) 
; (sdl-128 t 2) 


, added by BDC 02/05/88 


; (sdl-129 love in bloom) 
; (sdl-129 love in bloom) 


; added by BDC 02/05/88 
;from previous rule 
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(sdl-130 ? $’x) 

(sdl-130 (? $?x)) 

=> 

(assert (sdl- 130-result $’x)) 

(assert (sd 1- 130-result ($’x)))) 

(def rule sdl-ruie-130 "■ 

(declare (salience -t)) 

(or (not (sdl- 130-result rose is a rose)) 

(not (sd 1- 130-result (rose is a rose)))) 

= > 

(assert (fail sdl-130))) 

(defrule sdl-rule-131 "" 

(sdl- 13 1 ?a) 

(sdl- 131 (’a)) 

=> 

(bind ’b (string-append 7 a "-bar")) 

(assert (sdl- 131 -result ’b)) 

(assert (sd 1-131-result (’b)))) 

(defrule sdl-rule-131-1 
(declare (salience -l)) 

(or (not (sdl-131-result "foo-bar")) 

(not (sdl-131-result (*f oo-bar“) ) ) ) 

=> 

(assert (fail sdl-131)) 

(assert (fail (sdl-131)))) 

(defrule sdl-133-rule ■* 

(sdl - 133 ’first ? $?x) 

(sdl- 133 (’first ’ $’x)) 

=> 

(bind ?y (string-append ’first ■ -RESULT*) ) 
(assert (sdl-i33-result ’y $’x)) 

(assert (sd 1-133-result (?y $?x)))) 


; (sdl-130 a rose is a rose) 
; (sdl-130 a rose is a rose) 


, added by BDC 02/08/88 

;frorn previous rule 


, ■ foo 

; "foo* 


; added by BDC 02/05/88 


, (sdl-133 first second) $?x binds to nothing 
;(sdl-l33 first second) S’x binds to nothing 


(defrule sdl-133-rule-l •• 

(declare (salience -i)) ;added by BDC 02/05/88 

(or (not (sd 1 - 133-r esu 1 1 "FIRST-RESULT* ) ) ;froni previous rule 

(not (sdl-133-result ("FIRST- RESULT-)) ) ) 

-> 

(assert (fall sdl-133))) 


(defrule sdl-134-rule 

(sdl-134 republicans S’ ’x $?) ; (sdl-134 republicans fox Jones nixon williams harvey) 

(sdl-134 quakers $? ’x S?) 

(sdl-134 (republicans $? ?x $?)) ; (sdl-134 republicans fox Jones nixon williams harvey) 

(sdl-134 (qualcers $? ’x $?)) , (sdl-134 quakers pallas sanchez stone nixon fregge) 


(assert (sdl- 134-resu It ’x)) /’x is nixon 

(assert (sdl-134-result (?x)))) ;’x Is nixon 


(defrule sdl- 134-rule-l 

(declare (salience -1)) ;added by BDC 02/05/88 

(or (not (sdl-134-result nixon)) ; from previous rule 

(not (sdl-134-result (nixon)))) 

=> 

(assert (fail sdl-134))) 


(defrule sdl-135-rule 

; ; (sdl-135 yellow) (sdl-135 green) 

(sdl-135 ’a 4“red 4 "blue 4 'green 4 'violet 4 “orange 4 “black) 
; , (sdl-135 yellow) (sdl-135 green) 


107 



ART/ADA DESIGN PROJECT - PHASE I 


FINAL REPORT 


(sdl-135 ( 7 a ft’red ft ’blue 2 ’green k ’violet ft 'orange ft ’black)) 

=> 

(assert (sdl-135-result 7 a)) ;yellow 

(assert (sdl-135-resul t ( 7 a)))) .yellow 

(defrule sdl- 135-rul e- 1 •• 

(sdl- 135-result yellow) 

(sdl-135-resul t (yellow)) 

(not (sdl-135-result green)) 

(not (sdl - 135-result (green))) 

=> 

(assert (success sdl-135))) 

(defrule sdl-l35-rule-2 
(declare (salience -10)) 

(not (success sdl-135)) 

=> 

(assert (fall sdl-135))) 

(defrule sdl-136-rule ■■ 

(sdl- 136 ?a ftred I blue I green I violet I orange I black) ;yellow and green 
(sdl- 136 ( 7 a ftred I blue I green I violet ! orange I black)) ;yellow and green 

=> 

(assert (sdl-136-resul t ?a)) 

(assert (sdl-136-resul t (?a)))) 

(defrule sdl-136-rule-l 

(not (sdl-136-re*ult yellow)) 

(not (sdl-136-result (yellow))) 

(sdl-136-result green) 

(sdl-136-result (green)) 

=> 

(assert (success sdl-136))) 

(defrule sdl-136-rule-2 ■■ 

(declare (salience -10)) 

(not (success sdl-136)) 

=> 

(assert (fall sdl-136))) 

(defrule sdl-137-rule ■■ 

(sdl- 137 red I blue Igreen i violet t orange I black) 

(sdl- 137 (redlblueigreenlvloletl orange I black) ) 

=> 

(assert (fall sdl-137))) 

(defrule sdl-138-rule 

(or (not (sdl-138 red I blue I green I violet I orange I black)) ; yellow and green 

(not (sdl-138 (red I blue I green I violet I orange I black)))) 

=> 

(assert (fall sdl-138))) 

(defrule sdl-139-rule 

(or (not (sdl- 139 ?x =(abs ?x))) .-12 12 

(not (sdl- 139 (?x (=(abs ?x)))))) 

=> 

(assert (fall sdl-139))) 

(defrule sdl-140-rule M 


(sdl-140 
(sdl- 140 

?xl 7 yl) 

7 x2 k ' 7 xl ?y2 t "?yl) 

; l 1 

also 1 2 

(sdl-140 

(sdl-140 

( 7 xl ?yl)) 

(?x2 t ' 7 xi 7 y2 k ”?yl)) 

; t 1 

also 1 2 


, on e green asserted 

.one green asserted 

; should not exist 

.should exist 
.should exist 

;from previous rule 


, from previous rule 
.from previous rule 
; should be no such fact 


;prevlous rule 
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(assert (fall sdl-140))) 


(defrule sdl-141-mle 
(sdl-141 ’xl ’y l) 

(sdl-141 ?x2 ’y2) 

(sdl-141 (’xl ’yi) ) 

(sdl-141 (’x2 ’y2)) 

(test (or (not (= ’xl ’x2)) 

(not (= ?y l ’y2) ) ) ) 

= > 

(assert (success sdl-141))) 

(def rule sdl- 14 1 -mle-1 •• 

(declare (salience -10)) 

(not (success sdl-141)) 

=> 

(assert (fall sdl-141))) 

(def rule sdl-142-mle M 
(sdl-142 ?first ?second) 

(sdl-142 (?f lrst ?second) ) 

(assert (sdl-142 Tsecond 7 first)) 
(assert (sdl-142 (?second ’first)))) 

(def rule sdl-142-rqle~l •• 

(declare (salience -l)) 

(or (not (sdl-142 hot cold)) 

(not (sdl-142 (hot cold)))) 

= > 

(assert (fail sdl-142))) 

(def rule sdl-143-role 
(sdl-143 $?x red $?y) 

(sdl-143 ($? x red $?y)) 

=> 

(assert (sdl-143 red $?x $ 7 y)) 

(assert (sdl-143 (red $?x $?y)))) 

(def rule sdl-143-ml e - 1 
(declare (salience -l)) 

(or (not (sdl-143 red green yellow blue 
(not (sdl-143 (red green yellow blu 

=> 

(assert (fail sdl-143))) 


1 1 

also 

1 2 

1 1 

also 

1 2 


.cold hot 
.cold hot 

.hot cold 
; hot cold 


.added by 8DC 02/05/88 
.from above rule 


.green yellow red blue white 

.green yellow red blue white 


.added by BDC 02/05/88 
white)) ;from above rule 

white)))) 


(def rule sdl-144-rale • ■ 

(sdl-144 brother-of ’father ’uncle) 

(sdl-144 child-of ?father ’child) 

(sdl-144 sex-of ?chlld female) 

(sdl-144 (brother-of ?father ’uncle)) 
(sdl-144 (child-of ?father ?child)) 

(sdl-144 (sex-of ?child female)) 

=> 

(assert (sdl-144 niece-of ?uncle ’child)) 
(assert (sdl-144 uncle-of ’child ’uncle)) 
(assert (sdl-144 (niece-of ’uncle ’child))) 
(assert (sdl-144 (uncle-of ’child ’uncle)))) 

(def rule sdl-l44-rule-2 ■■ 

(sdl-144 brother-of ’father ’uncle) 

(sdl-144 child-of ?f ather ’child) 

(sdl-144 sex-of ’child male) 

(sdl-144 (brother-of ’father ’uncle)) 


; waiter daniel 
.waiter jane 
.jane female 
, waiter daniel 
;walter jane 
.jane female 

.daniel jane 

.daniel jane 
.Jane daniel 


.waiter daniel 
. waiter david 

.waiter daniel 
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(sdl-144 (chlld-of Tfather ?chlld)) 
(sdl-144 (sex-of ?chlld male)) 


;walter davld 

.davld male 


(assert (sdl-144 nephew-of ?uncle 7 chlld)) 
(assert (sdl-144 uncle-of ?child ’uncle)) 
(assert (sdl-144 (nephew-of ’uncle Tchlld))) 
(assert (sdl-144 (uncle-of ?chlld ’uncle)))) 


, waiter davld 

.waiter davld 
, davld waiter 


(de f rule sd 1-144-ru 1 e-3 " 

(sdl-144 niece-of danlel Jane) 
(sdl-144 uncle-of Jane danlel) 
(sdl-144 nephew-of danlel davld) 
(sdl-144 uncle-of davld danlel) 
(sdl-144 (niece-of danlel jane)) 
(sdl-144 (uncle-of Jane danlel)) 
(sdl-144 (nephew-of danlel davld)) 
(sdl-144 (uncle-of davld danlel)) 

=> 

(assert (success sdl-144))) 

(defrule sdl- l44-rule-4 ■■ 

(declare (salience -10)) 

(not (success sdl-144)) 

=> 

(assert (fall sdl-144))) 


.all from above rules 


;all from above rules 


; lf all here assert success 


(defrule sdl-rule-145 "" 
(sdl- 145-1 1st $ '’colors) 
(sdl- 145-list ($?colors) ) 


;red white blue 
; red white blue 


(bind ?i 1) 

(bind ? length (lengths '’colors)) ;3 

(while (<= ?i ’length) do 

(assert (sdl- 145-control =(nth$ ?colors ?D) 

(sdl-145-control (=(nthS ’colors ’1)))) 
(bind ’1 (♦ ’1 1)))) 


(defrule sdl-rule-145-1 ““ 
(sdl-145-control ’color) 
(sdl-145-control (Tcolor)) 

(or (not (sdl-145 ’color)) 

(not (sdl-145 (’color)))) 

=> 

(assert (fail sdl-145))) 

(defrule sdl-rule-146 
(sdl-146-seats S?seats) 

(sdl- 146-naaes S’names) 
(sdl-146-s«ats (S’seats)) 
(sdl-146-names (S’names)) 


.red or white or blue 
.red or white or blue 
;tf no matching generated fact 


.8 9 11 14 3 

; 8 9 11 14 3 

.torn carol fred alex 


(bind ?1 1) 

(bind ’length (min (length! ?seats) 

(length! ’names))) 
(while (< = ’1 ’length) do 

(assert (sdl-146-assignment 
=(nth! ’seat s ’1) 
=(nth! ’names ?i)) 

(sdl- 146- assignment 

(= (nth! ’seats ?1) 
=(nth! ?naraes ?i)))) 
(bind ’i (♦ ’1 1)))) 

(defrule sdl-rule-146-1 " 
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(sdl-146-assignment 8 tom) 

(sdl-146-assignment 9 carol) 

(sdl- 146-assignment 11 fred) 

(sd 1-1 46- assignment 14 alex) 

(sdl-1 46 -assignment (8 tom)) 

Csdl-146-assignment (9 carol)) 

(sdl-146-assignment C 1 1 fred)) 

(sdl-146-asslgnment (14 alex)) 

=> 

(assert (success sdl-146))) 

(defrule sdl-146-rule-2 
(declare (salience -10)) 

(not (success sdl-146)) 

r> 

(assert (fail sdl-146))) 

(defrule sdl-147 *■ 

?state-f act-1 <- (sdl-147-sum ?list 7 donor 7 sum-so-far) 
(sdl-147 ’list ?donor ?next-donor k "finish) 

(sdl-147 donation ?next-donor ?contribu tion) 

7 state-f act-2 <- (sdl-147-sum (?list 7 donor 7 sum-so-f ar) ) 
(sdl-147 (?list ?donor 7 next-donor k "finish)) 

(sdl-147 (donation ?next-donor Contribution)) 

=> 

(retract ?state-f act-1 7 state-f act-2) 

(assert (sdl-147-sum Cist ?next-donor 

=(+ 7 sum-so-f ar ?con tribu tion) ) ) 
(assert (sdl-147-sum (Cist 7 next-donor 

= <♦ 7 sum-so-far 7 contribution) ) ) ) ) 


(defrule sdl-147-2 

7 state-fact-l <- (sdl-147-sum 7 list 7 donor 7 sum) 

(sdl-147 ?llst 7 donor finish) 

?state-f act-2 <- (sdl-147-sum ( 7 list 7 donor 7 sum)) 

(sdl-147 (?list 7 donor finish)) 

=> 

(retract ?state-f act-1 7 state-fact-2) 

(assert (sdl-147-f inal ?llst 7 sum)) 

(assert (sdl-147-f inal ( 7 list 7 sum)))) 

(defrule sdl-147-3 ■■ 

(or (not (sdl-147-f inal donors 17.5)) 

(not (sdl-147-f inal (donors 17.5)))) 

- > 

(assert (fail sdl-147))) 

(defrule sdl-rule-148 •• 

(sdl-148 donor-list $ 7 donors) 

(sdl-148 (donor-list S?donors) ) 

=> 

(bind ?length (lengths ?donors)) 

(assert (sdl-148 donors start =(nth$ 7 donors 1))) 

(assert (sdl-148 (donors start =(nth$ 7 donors 1)))) 

(assert (sdl-148 donors =(nth$ 7 donors 7 length) finish)) 

(assert (sdl-148 (donors =(nth$ 7 donors ?length) finish))) 

(bind 7 i l) 

(while (< 7 i 7 length) do 

(assert (sdl-148 donors =(nth$ 7 donors 7 i) =(nth$ ?donors (+ 7 i 1))) 

(sdl-148 (donors =(nth$ 7 donors 7 i) =(nth$ 7 donors ( + 7 i 1))))) 
(bind ?i (♦ 7 i t)))) 

(defrule sdl-148-1 

7 state-f act-1 <- (sdl- 148-sura ?list 7 donor 7 sura-so-far) 
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(sdl-148 ’list ’donor ’next-donor k ’finish) 

(sdl-148 donation ?next-donor ’contribution) 

’state-fact-2 <- (sdl-148-sum (’list ’donor 7 sum-so-f ar) ) 
(sdl-148 (’list ’donor ’next-donor k ’finish)) 

(sdl-148 (donation ?next-donor ’contribution)) 

(retract ’state-fact-1 ’state- fact-2) 

(assert (sdl-148-sum ’list ’next-donor 

=(♦ ’sum-so-far ?contribu tlon) ) ) 
(assert (sdl-148-sum (’list ’next-donor 

=(+ ’sum-so-far ’contribution))))) 


(defrule sdl-148-2 ■■ 

’state-fact-1 <- (sdl-148-sum ’list ’donor ’sum) 

(sdl-148 ’list ’donor finish) 

’state-fact-2 <- (sdl-148-sum (?list ’donor ’sum)) 

(sdl-148 (’list ’donor finish)) 

= > 

(retract ?state-f act-1 ’state-fact-2) 

(assert (sdl-148-f inal ’list ’sum)) 

(assert (sdl-148-f Inal (?list ’sum)))) 

(defrule sdl-148-3 ,a 

(declare (salience -1)) .added by BDC 02/05/88 

(or (not (sdl-148- f inal donors 17.5)) 

(not (sdl-148-f inal (donors 17.5)))) 

=> 

(assert (fail sdl-148))) 

(defrule sdl-149 

(declare (salience 1000)) 

(sdl-149 inventory ’name ’amount) 

(sdl-149 (inventory ?name ’amount)) 

=> 

(assert (sdl-149 add-to-sura ’name ’amount)) 

(assert (sdl-149 (add-to-sura ?name ’amount)))) 

(defrule sdl-149-1 ■■ 

(declare (salience 1000)) 

’x <- (sdl-149 add-to-sum ’name ’amount) 

?y <- (sdl-149 current-sura ?sum) 

’z <- (sdl-149 (add-to-sum ?name ’amount)) 

’w <- (sdl-149 (current-sum ?sum)) 

=> 

(retract ’x ?y) 

(assert (sdl-149 current-sum =(♦ ’sum ’amount))) 

(assert (sdl-149 (current-sura =(+ ’sum ’amount))))) 

(defrule sdl-149-2 

(declare (salience -l)) added by BDC 02/05/88 

(or (not (sdl-149 current-sum 19.5)) 

(not (sdl-149 (current-sum 19.5)))) 

=> 

(assert (fall sdl-149))) 

(defrule sdl-150 " 

(declare (salience 1000)) 

(sdl-150 inventory ’name ’amount) 

(sdl-150 (inventory ’name ’amount)) 

=> 

(assert (sdl-150 count-item ’name ’amount)) 

(assert (sdl-150 (count-item ’name ’amount)))) 

(defrule sdl-150-1 ■■ 
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(declare (salience 1000)) 

<- (sdl-150 count-item ’name ’amount) 

7 y <- (sdl-150 current-count ’count) 

7 z <- (sdl-150 (count-item ?name ?amount)) 

? w <- (sdl-150 (current-count ’count)) 

(retract ’x ?y ?z ’v) 

(assert (sdl-150 current-count =(+ ?count 1 ))) 
(assert (sdl-150 counted ?name ?amount)) 

(assert (sdl-150 (current-count =(+ ’count l)))) 
(assert (sdl-150 (counted ?name ’amount))) 


(defrule sdl-150-2 " 

(declare (salience 1000)) 

? x <- (sdl-150 counted ?name ’amount) 

?z (sdl-150 (counted ?name ’amount)) 

(or (not (sdl-150 inventory ’name ’amount)) 

(not (sdl-150 (inventory ’name ?amount)))) 
7 y <- (sdl-150 current-count ?count) 

?w <- (sdl-150 (current-count ?count)) 

~> 

(retract ’x ’y ?w ’z) 

(assert (sdl-150 current-count = (- ’count l))) 
^(assert (sdl-150 (current-count =(- ?count 1)))) 


(defrule sdl-150-3 11 
(declare (salience -l)) 

(or (not (sdl-150 current-count 3)) 
(not (sdl-150 (current-count 3) )) ) 

-> 

(assert (fail sdl-150))) 

(defrule sdl-151 
(sd 1-151 quarter ?v) 

(sdl-151 dime ?x) 

(sdl-151 nickel ?y) 

(sdl-151 penny ’z) 

(sdl-151 (quarter ’v)) 

(sdl-151 (dime ?x)) 

(sdl-151 (nickel ’y)) 

(sdl-151 (penny ?z)) 

(test (> ’v ’x ?y ? z) ) 

=> 

(assert (success sdl-151))) 

(defrule sdl-151-1 
(declare (salience -10)) 

(not (success sdl-151)) 

=> 

(assert (fall sdl-151))) 

(defrule sdl-152 

(sdl-152 quarter ’v) 

(sdl-152 dime ’x) 

(sdl-152 nickel ?y) 

(sdl-152 penny ’z) 

(sdl-152 (quarter ’v)) 

(sdl-152 (dime ’x)) 

(test (> ?w ’x)) 

(sdl-152 (nickel ’y) ) 

(test (> ?x ?y) ) 

(sdl-152 (penny ’z)) 


: added by BDC 02/05/80 


,10 

; 8 
; 6 
14 

,8 

.6 


; 4 
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(test, (> 7 y ?*)) 

= > 

(assert (success sdl-152))) 

(defrule sdl-152-1 

(declare (salience -10)) 
(not (success sdl-152)) 

= > 

(assert (fall sdl-152))) 


(defrule sdl-153 "* 

(sdl-153 ?ansver 4 yes 1 no I unknown 
(sdl-153 ( 7 answer 4 yes l no I unknown 


: (numberp ?answer)) ,yes, no, unknown, 
: (numberp 7 answer))) .yes, no, unknown, 


(assert (sdl-153 matched ’answer)) 
(assert (sdl-153 (matched ’answer)))) 


(defrule sdl-153-1 

(sdl-153 matched yes) 
(sdl-153 matched no) 
(sdl-153 matched unknown) 
(sdl-153 matched 1) 

(sdl-153 (matched yes)) 
(sdl-153 (matched no)) 
(sdl-153 (matched unknown)) 
(sdl-153 (matched 1)) 

=> 

(assert (success' sdl-153) ) ) 


(defrule sdl-153-2 ,B 

(declare (salience -10)) 
(not (success sdl-153)) 

-> 

(assert (fall sdl-153))) 


(defrule sdl-154 

(sdl-154 ?timel 4 : (numberp ?tlmel)) 
(sdl-154 7 time2 4 : (numberp ?tlme2) 4 
(sdl-154 (? time 1 4 : (numberp ?tlmel))) 
(sdl-154 (?tlme2 4 (numberp ?time2) 4 


(> ?tlrae2 7 timel) 

: (> ? tlme2 Ttlmel) 


) 


)) 


(assert (sdl-154-raatched 7 timel ?tlme2)) 
(assert (sdl-154-matched (?tlmel 7 time2)))) 


(defrule sdl-154-1 

(sdl-154-matched 1 2) 

(sd 1- 154-matched 2 3) 
(sdl-154-matched 1 3) 

(sdl- 154-matched (1 2)) 
(sdl-154-matched (2 3)) 
(sdl- 154-matched (1 3)) 

=> 

(assert (success sdl-154))) 

(defrule sdl-154-2 ■* 

(declare (salience -10)) 
(not (success sdl-154)) 

=> 

(assert (fail sdl-154))) 


(defrule sdl-155 M 

(sdl-155 7 tlmel 4 (numberp 7 tlrael)) 
(sdl-155 7 time2 4 : (numberp 7 time2)) 
(sdl-155 (? time 1 4 (numberp ?timel))) 


FINAL REPORT 


1 

1 
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(sdl-155 (’time2 ft : (nuaberp ?tlme2))) 

(test (> ’time2 ’timel)) 

-> 

(assert (sdl-155 matched ’timel ’tlme2)) 

(assert (sdl-155 (snatched ’timel ?time2)))) 

(defrule sdl-155-1 * a 
(sdl-155 matched 1 2) 

(sdl-155 matched 2 3) 

(sdl-155 matched 1 3) 

(sdl-155 (matched 1 2)) 

(sdl-155 (matched 2 3)) 

(sdl-155 (matched 1 3)) 

= > 

(assert (success sdl-155))) 

(defrule sdl-155-2 

(declare (salience -10)) 

(not (success sdl-155)) 

=> 

(assert (fall sdl-155))) 

(defrule sdl-156 ““ 

(or (not (sdl-156 ?x k yes 1 no l : (numberp ?x) I : (stringp ?x))) 
(not (sdl-156 (?x ft yes 1 no | : (numberp ?x) I : (stringp ?x))))) 

= > 

(assert (fall sdl-156))) 
vvvv 

(defrule sdl-157 ■■ 

(or (not (sdl-157 ?x ft : (stringp ?x) j yes I no I : (numberp ?x) ) ) 
(not (sdl-157 (?x ft : (stringp ?x) I yes ! no I ; (numberp ?x))))) 

=> 

(assert (fall sdl-157))) 

(defrule sdl-158 

(or (not (sdl-158 ?x ft : (stringp ?x))) 

(not (sdl-158 (?x ft : (stringp ?x))))) 

=> 

(assert (fail sdl-158))) 

(defrule sdl-159 ■■ 

(sdl-159 ?answer ft yes I no I unknown I : (numberp ’answer)) 

(sdl-159 (Tanswer ft yes I no I unknown I : (numberp ?ansver))) 

_> 

(assert (sdl-159 matched ’answer)) 

(assert (sdl-159 (matched ’answer)))) 

(defrule sdl-159-1 ■■ 

(sdl-159 matched yes) 

(sdl-159 matched no) 

(sdl-159 matched unknown) 

(sdl-159 matched 1) 

(sdl-159 (matched yes)) 

(sdl-159 (matched no)) 

(sdl-159 (matched unknown)) 

(sdl-159 (matched 1)) 

=> 

(assert (success sdl-159))) 

(defrule sdl-159-2 ■ ■ 

(declare (salience -10)) 

(not (success sdl-159)) 

=> 

(assert (fail sdl-159))) 
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(defrult sdl-160 

(sdl-160 ?answer 4 : (numberp ^answer) I yes I no I unknown) 
(sdl-160 (^answer * : (numberp ^answer) I yes I no I unknown)) 

=> 

(assert (sdl-160 matched ^answer)) 

(assert (sdl-160 (matched ^answer)))) 

(defrule sdl-160-1 

(sdl-160 matched yes) 

(sdl-160 matched no) 

(sdl-160 matched unknown) 

(sdl-160 matched 1) 

(sdl-160 (matched yes)) 

(sdl-160 (matched no)) 

(sdl-160 (matched unknown)) 

(sdl-160 (matched 1)) 

=> 

(assert (success sdl-160))) 

(defrule sdl-160-2 

(declare (salience -10)) 

(not (success sdl-160)) 

=> 

(assert (fail sdl-160))) 

(defrule sdl- 161 ■ • 

(sdl-161 7 tirae 14 : (numberp ?timel)) 

(sdl-161 (?timel4: (numberp ?tlmei))) 

(sdl-161 ?tlme2t : (numberp ?time2)4:(> 7 tlme2 ?timel)) 

(sdl-161 ( 7 time24 : (numberp ?tlme2)4:(> ?tirae2 ?tlmel))) 

=> 

(assert (sdl-161 matched ?timel ?time2))) 

(defrule sd 1-161-1 
(sdl-161 matched 1 2) 

(sdl-161 matched 2 3) 

(sdl-161 matched 1 3) 

=> 

(assert (success sdl-161))) 

(defrule sdl-161-2 ■■ 

(declare (salience -10)) 

(not (success sdl-161)) 

=> 

(assert (fail sdl-161))) 

(defrule sdl-162 ■* 

(sdl-162 ?time 14 : (numberp ?tlmel)) 

(sdl-162 (?tlmel4: (numberp ?tlmel))) 

(sdl-162 ?tlme24 : (numberp ?time2)) 

(sdl-162 (?tlme24: (numberp ?time2))) 

(test (> ?time2 ?tlmel)) 

= > 

(assert (sdl-162 matched ?tlrael 7 tirae2))) 

(defrule sdl-162-1 ■■ 

(sdl-162 matched l 2) 

(sdl-162 matched 2 3) 

(sdl-162 matched 1 3) 

=> 

(assert (success sdl-162))) 

(defrule sdl-162-2 ■■ 

(declare (salience -10)) 
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(not (success sdl-162)) 

=> 

(assert (fail sdl-162))) 

(defrule sdl-163 

(or (not (sdl-163 ?lnput k "yes" I "no" I "unknown" i "overflow" I "Inference") 
(not (sdl-163 (?input k "yes" I "no" I "unknown" I "overflow" ! "inference" 

-> 

(assert (fail sdl-163))) 

(defrule sdl-164 " 

(sdl-164 input ?lnput) 

(sdl-164 list $?list) 

(sdl-164 (input ’input)) 

(sdl-164 (list S’llst)) 

- > 

(if (position! ’input ’list) 
then 

(assert (success sdl-164)) 
else 

(assert (fail sdl-164)))) 

(defrule sdl-165 "" 

(or (not (sdl-165 12345.89)) 

(not (sdl-165 (12345.89)))) 

= > 

(assert (fail sdl-165))) 

(defrule sdl-166 •« 

(patient-name ’patieut-1) 

(patient-name (?patitnt-l ) ) 

(sdl-166 $? ’patient-1 $’ 

’answer k 
yes | 
no | 

unknown I 

: (nuraberp ’answer) $?) 

(sdl-166 $? ’answer k 

yes | 

no I 

unknown I 

: (numbtrp ’answer) $? 

?patleot-l $?) 

(sdl-166 ($? ’patient-1 $? 

’answer t 
yes I 
no I 

unknown I 

: (numberp ?answer) $?)) 

(sdl-166 ($? ? answer * 

yes I 
no I 

unknown I 

: (numbnrp ?answer) $’ 

’patient-1 $?)) 

=> 

(assert (sdl- 166-matched ’patient-1 ?answer)) 

(assert (sdl-166-matched (?patlent-l ’answer)))) 

(defrule sdl-166-1 "" 

(sdl -166-matched paul 1.5) 

(sdl-166-matched paul yes) 

(sdl-166-matched (paol 1.5)) 

(sdl-166-matched (paal yes)) 


, "overflow" 

; "overflow" 

,"yes" "no" "unknown" "overflow" 


.matches literal fact 

,paul brad 
,paul brad 


FINAL REPORT 


) 

)))) 


" inference " 
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(assert (success sdl-166))) 

(defrule sdl-166-2 ■■ 

(declare (salience -10)) 

(not (success sdl-166)) 

-> 

(assert (fail sdl-166))) 

(defrule sdl-167 " 

(patient-name ’patient-1) 

(patient-name (?patient-l) ) 

(patient-name ’patient-2 k “’patient-1) 
(patient-name (?patient-2 k “’patient- 1) ) 

(or (sdl-167 $?w ’patient-1 
$’x ’patlent-2 
$?y ?answer k 
yes I 
no I 

un)cnovn I 
: (numberp ’answer) 

S?z) 

(sdl-167 $?v ’patient-1 
$?x ?ansver k 
yes I 
no 1 

unknown I 
: (numberp ?ansver) 

$?y ?patient-2 
$?z) 

(sdl-167 ($?w ?patient-l 
$?x ’patient-2 
$?y ’answer k 
yes I 
no I 

unknown I 

: (numberp ’answer) 

$?z)) 

(sdl-167 ($?w ’patlent-1 
$?x ?answer k 
yes I 
no I 

unknown I 
: (numberp ’answer) 

$’y ’patient-2 

$?z))) 

= > 

(assert (sdl-167-matched ?patient-l ?ansver)) 
(assert (sdl-167-matched ?patient-2 ’answer)) 
(assert (sdl-167-matched (?patient-l ?answer))) 
(assert (sdl-167-matchtd (?patient-2 ’answer)))) 


(defrule sdl-167-1 
(sdl-167-matched 
(sdl- 167-matched 
(sdl-167-matched 
(sdl- 167-matched 
(sdl-167-matched 
(sdl-167-matched 
(sdl-167-raatched 
(sdl-167-matched 

-> 

(assert (success 


paul 1.5) 
paul yes) 
brad 1 . 5) 
brad yes) 
(paul 1.5)) 
(paul yes)) 
(brad 1.5)) 
(brad yes)) 

sdl-167))) 
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(defrule sdl-167-2 

(declare (salience -10)) 

(not (success sdl-167)) 

=> 

(assert (fail sdl-167))) 

(defrule sdl-163 

(patient-name 7 patient-l) 

(patient-name 7 ?at;ent-2 k ”?patlent-l) 

(patient-name (''patient- 1 ) ) 

(patient-name ( 7 patient-2 k “''patient- 1) ) 

(or (sd 1-168 $ 7 v 

^answer- 1 k yes I no I : (numberp 7 answer-l) 
$?w 

7 patient-l 

$ 7 x 


, ; split the fact BEFORE the second answer 
7 ansver-2 k yes I no I : (numberp ?answer-2) 
$ 7 y 

?patien t-2 
$ 7 z) 

(sdl-168 $?v 

?patient-i 

$?w 

?answer-l k yes | no | : (numberp 7 answer-l) 

- . split the fact AFTER the first answer 
$?x 

7 patient-2 

$?y 

7 ansver-2 k yes 1 no i : (numberp ?answer-2) 
$ 7 z) 

(sdl-168 ($ 7 v 

?answer-l k yes I no I : (numberp ?answer-l) 
$?w 

7 patient-l 

$ 7 x 


, , split the fact BEFORE the second answer 
7 ansver-2 1 yes I no I : (numberp 7 answer-2) 
$ 7 y 

7 patient-2 

$ 7 z)) 

(sdl-168 ($ 7 v 

7 pati ent-t 
$ 7 v 

? answer-l k yes I no I : (numberp 7 answer-l) 
split the fact AFTER the first answer 

$?x 

?patient-2 

$?y 

7 ansver-2 k yes I no I : (numberp 7 answer-2) I 
S 7 z))) 

=> 

(assert (sdl-1 68-matched 7 patient-l 7 answer-l)) 

(assert (sd 1- 1 68-matched 7 patient-2 7 answer-2)) 

(assert (sd l-i 68-matched ( 7 patient-l 7 answer-i))) 

(assert (sdl-l 68-matched ( 7 patient-2 7 answer-2) ) ) ) 

(defrule sdl-168-1 

(sdl- l 68-matched paul yes) 

(sdl-168-matched paul 1,5) 


I unknown 


I unknown 


I unknown 


I unknown 


I unknown 


I unknown 


I unknown 


unknown 


119 



ART/ADA DESIGN PROJECT - PHASE I 


FINAL REPORT 


(sdl- 168 -matched brad NO) 

(sdl- 168 -matched brad unknown) 

(sdl- 168 -matched (paul yes)) 

(sd 1 - 1 60-matched (paul 1.5)) 

(sdl- 168 -matched (brad NO)) 

(sdl- 168 -matched (brad unknown)) 

=> 

(assert (success sdl-168))) 

(def rule sdl-168-2 * ' 

(declare (salience -10)) 

(not (success sdl-168)) 

=> 

(assert (fail sdl-168))) 

(defrule sdl-169-0 

(declare (salience 100)) 

? a <- (sdl-169 $?bef ore ?ansver ft yes 
I no 

$?middle not $?after) 

<- (sdl-169 ($?before ^answer ft yes 
I no 

$ 7 middle not $?after)) 

=> 

(retract 7 a ?b) 

(if 

(equal ^answer yes) 

then (assert (sdl-169 $ 7 before ^answer $?raiddle no $?after) 

(assert (sdl-169 ($?before ?answer $?mlddle no S?after)))) 
else (assert (sdl-169 $ 7 before ?ansver $?middle yes $?after) 

(assert (sdl-169 ($?before ?answer $?middle yes $?af ter) ) ) ) ) ) 


(defrule sdl-169 ■■ 

(patient-name ?patient-l) 

(patient-name ?patient-2 ft “?patient-l) 

(patient-name (?patient-i) ) 

(patient-name (?patient-2 ft ~?patient-l) ) 

(or (sdl-169 $?v 

7 answer-l ft yes I no I : (numberp 7 answer-l) I unknown 

$ 7 v 

?patient-i 

$ 7 x 


split the fact BEFORE the second answer 
7 ansver-2 ft yes I no I ' (numberp ?answer-2) I unknown 

$ 7 y 

7 patient-2 

$?z) 

(sdl-169 $?▼ 

?patient-t 

$?v 

?answer-l ft yes I no I : (numberp 7 answer-l) I unknown 

;; split the fact AFTER the first answer 
$?x 

?patl ent-2 

$?y 

’answer-2 4 yes I no I : (numberp ?answer-2) I unknown 

$?z) 

(sdl-169 (S?v 

?answer-i ft yes I no I : (numberp 7 answer-l) I unknown 
$ 7 w 

?patient-l 

$ 7 x 
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.. split tb« fact BEFORE the second answer 
’answer-2 t yes I no I (numbers ’answer-2) 

*’7 

7 patient-2 

$ 7 z)) 

(sdl-169 ($ 7 v 

7 patient-l 

$ 7 v 

7 ansver-l ft yes I no I : (numberp ?ansver-l) 

, , split the fact AFTER the first answer 
$?x 

7 patient-2 

$ 7 y 

7 answer-2 ft yes I no I : (numberp 7 ansver-2) 
$ 7 z))) 

-> 

(assert (sdl- 1 69-matched ?patlent-l ?ansver-l)) 

(assert (sdl-169-matched 7 patient-2 7 ansver-2)) 

(assert (sd 1 -169-matched (?patient-l ?ansver-l))) 
(assert (sdl- 169-matched (?patient-2 7 ansver-2) ) ) ) 

(defrule sdl-169-1 ■■ 

(sdl-169-matched paul yes) 

(sdl-169-matched brad NO) 

(sdl - l 69-matched (paul yes)) 

(sdl-169-matched (brad NO)) 

-> 

(assert (success sdl-169))) 

(defrule sdl-169-2 
(declare (salience -10)) 

(not (success sdl-169)) 

=> 

(assert (fail sdl-169))) 

(defrule sdl-170 ■ ■ 

(patient-name 7 patlent) 

(patient-name ( 7 patlent)) 

(sdl-170 Tpatient COMPLAINS I HAS S? 

Tcomplaint k blackout I 

faintness I 

fatigue I 

headache j 

vertigo I 

anxiety | 

confusion | 

depression I 

drowsiness ( 

nervousness I 

numbness I 

paralysis | 

tension I 

tingling I 

weakness $?) 

(sdl-170 ( 7 patlent COMPLAINS I HAS $? 

?complaint ft blackout I 

faintness I 

fatigue I 

headache I 

vertigo I 

anxiety | 

confusion | 

depression I 


I unknown 


I unknown 


I unknown 
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drowsiness l 
nervousness ! 
numbness I 
paralysis I 
tension I 
tingling I 
weakness $?)) 

-> 

(assert (sdl-170-complaint ?patient Tcomplaint)) 
(assert (sdl-170-complamt (’patient ?coraplaint) ) ) ) 

(def rule sdl-170-1 

(sdl-170-complaint paul vertigo) 

(sdl -170- complaint paul faintness) 
(sdl-170-complaint brad headache) 

(sdl- 170-comp lalnt (paul vertigo)) 

(sdl-170-complain t (paul faintness)) 

(sdl -170 -comp lalnt (brad headache)) 

=> 

(assert (success sdl-170))) 

(defrule sdl-170-2 ■■ 

(declare (salience -10)) 

(not (success sdl-170)) 

-> 

(assert (fail sdl-170))) 

(defrule sdl-171 ■■ 

(patient-name Tpatient) 

(age ’patient ’age 2 "unknown 
2 : (>= ?age 21) ) 

(patient-name (’patient)) 

(seq-age ?patient (?age 2 "unknown 

2 : (>= ’age 21) ) ) 

=> 

(assert (sdl-171 ’patient yes)) 

(assert Csdl-171 (’patient yes)))) 

(defrule sdl-171-2 M 
(patient-name ’patient) 

(age ’patient ’age 2 "unknown 
2 : (< ’age 21) ) 

(patient-name (’patient)) 

(seq-age ’patient (’age 2 "unknown 
2 (< ’age 21))) 

= > 

(assert (sdl-171 ’patient no)) 

(assert (sdl-171 (’patient no)))) 

(defrule sdl-171-3 ■■ 

(sdl-171 paul yes) 

(sdl-171 brad no) 

(sdl-171 (paul yes)) 

(sdl-171 (brad no)) 

=> 

(assert (success sdl-171))) 

(defrule sdl-171-4 •• 

(declare (salience -10)) 

(not (success sdl-171)) 

= > 

(assert (fail sdl-171))) 

(defrule sdl-172-2 *" 
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(patient-name Tpatient) 

(patient-name ( 7 patient)) 

(sdl-172 major-complaint ?patient 
^reason ft 
drowsiness \ 
confusion) 

(sdl-172 recent-head-injury ^patient no) 
(sdl-172 confusion-mild ^patient yes) 
(sdl-172 (major-complaint ^patient 
^reason ft 
drowsiness I 
confusion)) 

(sdl-172 (recent-head-injury ^patient no)) 
(sdl-172 (confusion-mild ^patient yes)) 

(or (not (sdl-172 major-complaint ?patient 
“confision k 
“drowsiness) ) 

(not (sdl-172 (major-complaint ?patient 
“confesion k 
“drowsiness) ) ) ) 


,one of these complaints 
.no recent head injury 

.one of these complaints 

;no recent head injury 
;mild symptom 


.no other complaints 


(assert (sdl-172 recommendation ^patient waiting room)) 
(assert (sdl-172 (recommendation ?patient waiting room)))) 

(defrule sdl-172-3 ■■ 

(sdl-172 recommendation paul waiting room) 

(sdl-172 (recommendation paul waiting room)) 

(or (not (sdl-172 recommendation brad waiting room)) 

(not (sdl-172 (recommendation brad waiting room)))) 

=> 

(assert (success sdl-172))) 

(defrule sdl-172-4 ■■ 

(declare (salience -10)) 

(not (success sdl-172)) 

-> 

(assert (fail sdl-172))) 


(defrule sdl-173 "* 

(sdl-173 Teasel ?al ?bl ?cl) 

(sdl-173 (^asel 7 al 7 bl ?cl)) 

(sdl-173 7 case2 k “easel k “foo k ‘bar 

7 a2 k : (not (symbolp ?a2)) k : (numberp ?a2) k 

7 b2 k : (not (sjrmbolp ?b2)) ft (numberp 7 b2) ft 

7 c2 ft : (not (symbolp 7 c2)) ft .(numberp ?c2) ft 

(sdl-173 (?case2 ft “easel ft “foo ft “bar 

7 a2 ft (not (symbolp 7 a2)) ft (numberp 7 a2) ft 

?b2 ft : (not (symbolp 7 b2)) ft : (numberp 7 b2) ft 

7 c2 ft : (not (symbolp 7 c2)) ft : (numberp 7 c2) ft 

r> 

(assert (sdl- 173-matcbed Teasel 7 case2)) 

(assert (sdl- 173-matched (Teasel ?case2)))) 


(< Ta2 7 al ) 

(> 7 b2 7 b l ) 

(< 7 c2 7 cl) ) 

(< 7 a2 Tal ) 

(> 7 b2 7 bl) 

(< Tc2 7 cl))) 


(defrule sdl-173-3 ■■ 

(sdl-i73-matched easel case2) 
(sdl-173-matched (easel case2)) 

(or (not (sd 1 - 173-matched “easel ~case2)) 

(not (sdl-173-matched (“easel “case2)))) 

= > 

(assert (success sdl-173))) 


(defrule sdl-173-4 

(declare (salience -10)) 
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(not (success sdl-173)) 


(assert (fail sdl-173))) 


(def rule sdl-174 ■■ 
(sdl-174 ’easel ? 
(sdl-174 (?case 1 7 
(sdl-174 ’case2 k 


(sdl-174 


* ’ ’al 1 
’ ? ?al 
'easel k 


?bi ? 

? ?bl ? 
'foo k 


? cl) 

?cD) 

’bar ’ 


7 a2 

k 

(not 

(symbolp ?a2)) 

k 

(numberp 

7 a2) 

k 

: (< 

?a2 

7 al) ? 

o 

tr 

to 

k 

(not 

(symbolp ?b2)) 

k 

(numberp 

7 b2) 

k 

: (> 

?b2 

7 bl) 7 

?c2 

k 

(not 

(symbolp ’c2)) 

k 

(numberp 

7 c2) 

k 

: (< 

?c2 

?cl) ) 

(?case2 

k ~ 

:asel k "foo k 

"bar ’ ’ ? 






’a2 

k 

(not 

(symbolp ’a2)) 

k 

(numberp 

7 a2) 

k 

: (< 

?a2 

?al) ? 

’b2 

k 

(not 

(symbolp ?b2)) 

k 

(numberp 

?b2) 

k 

: (> 

?b2 

7 bl) 7 

’c2 

k 

(not 

(symbolp ?c2)) 

k 

(numberp 

?c2) 

k 

: (< 

?c2 

?cl))) 


(assert (sdl-174-matched ’easel ’case2)) 

(assert (sdl-174-matched (?casel ’case2)))) 

(defrule sdl-174-3 

(sdl - 174-matched easel case2) 

(sdl- 174-matched (easel case2)) 

(or (not (sdl-174-matched 'easel ~case2)) 

(not (sdl-174-matched (“easel ~case2)))) 

-> 

(assert (success sdl-174))) 

(defrule sdl-174-4 ■■ 

(declare (salience -10)) 

(not (success sdl-174)) 

= > 

(assert (fail sdl-174))) 

(defrule sdl-175 ■■ 

(sdl-175 pallet ?pallet) 

(sdl-175 options S’optlons) 

(sdl-175 (pallet ’pallet)) 

(sdl-175 (options $?options)) 

(sdl-175 case ’ASB 

*:(=(/ (- ’ASB (mod ’asb 1000)) 1000) ’PALLET) 
k :(= 0 (POSITIONS ’asb ’OPTIONS))) ; if not a member 
(sdl-175 (case ’ASB 

k ; (= (/ (- ’ASB (mod ?asb 1000)) 1000) ? PALLET) 
k :(= 0 (POSITIONS ?asb 70PTI0NS)))) ; if not a member 

=> 

(assert (sdl - 175-matched ?asb)) 

(assert (sdl - 175-matched (’asb)))) 

(defrule sdl-175-3 ■■ 

(sdl-175-matched *5000) 

(sdl-17S-matched (“5000)) 

=> 

(assert (fail sdl-175))) 


(defrule sdl-176 

(sdl-176 options S’optlons) 

(sdl-176 (options S’options)) 

(sdl-176 case ’asb 

k : (not (= (positions ’asb ’options) 0))) 
(sdl-176 (case ’asb 

k : (not (= (position! ’asb ’options) 0)))) 

=> 

(assert (sdl- 176-matched ’asb)) 

(assert (sdl-176-matched (’asb)))) 


124 


ART/ ADA DESIGN PROJECT - PHASE I 


FINAL REPORT 


(defrule sdl-176-3 

(sdl-176-matched '50 00) 

(sdl-176-matched ("5000)) 

= > 

(assert, (fail sdl-176))) 

(defrule sdl-177 “ * 

(sdl-177 options S’options) 

(sdl-177 (options S’options)) 

(sdl-177 case °ASB 

A ; (= 0 (POSITIONS ’asb ’OPTIONS) ) ) 

(sdl-177 (case ’ASB 

A : (= 0 (POSITIONS ’asb ’OPTIONS)))) 

-> 

(assert (sdl-177-matched ’asb)) 

(assert (sdl-177-matched (’asb)))) 

(defrule sdl-177-3 

(sdl-177-matched "5000) 

(sdl-177-matched (~5"0)) 

= > 

(assert (fail sdl-177))) 

(defrule sdl-178 " " 

(or (not (sdl-178 ?a 

A (not (symbolp ’a)))) 

(not (sdl-178 (’a 

A : (not (symbolp ’a)))))) 

-> 

(assert (fail sdl-178))) 

(defrule sdl-179 •* 

(sdl-179 options S’options) 

(sdl-179 case ’ASB) 

(sdl-179 (options S’options)) 

(sdl-179 (case ’ASB)) 

(test (not (= 0 (POSITIONS ’asb ?OPTIONS)))) 

=> 

(assert (sdl - 179-matched ^asb)) 

(assert (sdl-179-matched (?asb)))) 

(defrule sdl-179-3 

(sdl-179-matched "5000) 

(sdl-179-matched ("5000)) 

- > 

(assert (fail sdl-179))) 

(defrule sdl-180 

(sdl- 180 options $?options) 

(sdl-180 case ’ASB) 

(sdl-180 (options S’options)) 

(sdl-180 (case ’ASB)) 

(test (= (POSITIONS ’asb ’OPTIONS) 0)) 

= > 

(assert (sdl- 180 -matched ’asb)) 

(assert (sdl- 180 -matched (’asb)))) 

(defrule sdl-180-3 " • 

(sdl-180-matched "5000) 

(sdl- 180 -matched (*5000)) 

=> 

(assert (fail sdl-180))) 

(defrule sdl-181 "" 
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(sdi-181 5000) 

(sd 1-181 (5000)) 

(or (not (sdl-181 ’5000)) 

(not (sdl-181 (*5000)))) 

-> 

(assert, (fail sdl-181))) 

(defrule sdl-182 

(declare (salience 100)) 

(sdl-182 ’r’est 4 “ * pst ’ ?pst 4 ’'est') 
(sdl-182 (?est 4 “’pst" ?pst 4 '"est")) 

= > 

(assert (sdl - 182-matched ?est ? pst)) 
(assert (sdl-I82-matched (?est ?pst)))) 

(defrule sdl-182-1 ” 

(or 

(sdl-182-matched "pst* "pst") 

(sdl- 182-matched 'est* "est - ) 
(sdl-182-matched ’pst* "est") 
(sdl-182-matched (’pst’ ’pst’)) 
(sdl-182-raatched (“est" ’est’)) 
(sdl-182-matched (’pst’ “est*)) 

(not (sdl- 182-matched ’est’ ’pst’)) 
(not (sdl- 182-matched ("est" ’pst*)))) 

=> 

(assert (fall sdl-182))) 

(defrule sdl-183 ” 

(sdl-183 "=(♦ l l)) 

(sdl-183 (-=(♦ l l))) 

=> 

(assert (fall sdl-183))) 

(defrule sdl-184 
(sdl-184 ’2) 

(sdl-184 (“2)) 

=> 

(assert (fail sdl-184))) 

(defrule sdl-185 •• 

(sdl-185 '’string*) 

(sdl-185 (“’string’)) 

= > 

(assert (fail sdl-185))) 

(defrule sdl-186 ” 

(declare (salience 100)) 

(sdl-186 ?strlng 4 “’string*) 

(sdl-186 (?string 4 “’string’)) 

_> 

(assert (sdl- 186-matched ?strlng)) 

(assert (sdl- 186-matched (?string)))) 

(defrule sdl-186-1 ” 

(or 

(sdl - 1 86-matched ’string*) 

(sd 1 - 1 86-matched (’string*)) 

(not (sdl - 186-matched ’foo’)) 

(not (sdl- 186-matched (*foo*)))) 

= > 

(assert (fall sdl-186))) 

(defrule sdl-187 ” 
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(declare (salience 100)) 

(sdl-187 7 stri ngl A ’"string* 7 string2 A ’'string*) 

(sdl-187 (?strlngl A '*string* 7 string2 A ’-string*)) 

=> 

(assert (sdl-187-jnatcbed ^string! 7 string2)) 

(assert (sdl-1 87-roatched (?strlngl 7 string2)))) 

(defrule sdl-187-l ■■ 

(or 

(sdl - l 97-matched 'string* *foo*) 

(sdl- 187-matched (*strlng* *foo*)) 

(not (sdl- 187-matched *foo* “foo")) 

(not (sd 1- 187-matched (*foo* *foo*)))) 

=> 

(assert (fail sdl-187))) 

(defrule sdl-188 "" 

(sdl-188 ’=(string-append "foo* "bar*)) 

(sdl-188 (“=(string-append *foo" *bar*))) 

=> 

(assert (fail sdl-188))) 

(defrule sdl-189 " 

(sdl- 189 ?a A ’=(♦ 1 D) 

(sdl-189 ( 7 a A ” = (♦ 1 1))) 

=> 

(assert (fail sdl-189))) 

(defrule sdl-190 ■■ 

(sdl-190 ?a A : (not (numberp 7 a))) 

(sdl-190 (?a A : (not (numberp ? a)))) 

= > 

(assert (sdl -1 90-matched ’a)) 

(assert (sdl - 1 90-matcbed (?a)))) 

(defrule sdl-190-1 ** 

(or 

(sdl-190-matched 1) 

(sdl- 190-matched (1)) 

(not (sdl-190-matched foo)) 

(not (sdl-190-matched (foo)))) 

=> 

(assert (fail sdl-190))) 

(defrule sdl-191 ** 

(sdl-191 ’1 A ’0.1 A **fOO* A ’bar A ’2 A ’12345.6789 A ’“fee* A ’blee) 
(sdl-191 (*i A *0.1 A ’*foo* A ’bar A ’2 A ’12345 6789 A ’"fee* A ’blee)) 

=> 

(assert (fail sdl-191))) 

(defrule sdl-192 •* 

(sdl-192 ?char-num A : (or (<= 97 7 char-num 102) 

(<= 65 ? char-num 70) 

(<= 48 7 char-num 57))) 

(sdl-192-seq ( 9 char-nu« A : (or (<= 97 7 char-num 102) 

(<= 65 ?char-num 70) 

(<= 48 ? char-num 57)))) 

=> 

(assert (sd 1 -1 92-matcbed 7 char-nura)) 

(assert (sdl-192-matcbed (?char-num) ) ) ) 

(defrule sdl-192-1 ** 

(or 

(sdl-1 92-matched 40) 
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(not (sdl-192-matched 50)) 

(sdl-192-matched 60) 

(not (sdl-192-matched 70)) 

(sdl- 192-matched 80) 

(sdl-192-matched 90) 

(not (sdl-192-matched 100)) 

(sdl-1 92-matched (40)) 

(not (sdl T 92-matched (50))) 

(sdl-192-matched (60)) 

(not (sdl -192-matched (70))) 

(sdl- 192-matched (80)) 

(sdl- 192-matched (90)) 

(not (sdl-192-matched (100)))) 

-> 

(assert (fail sdl-192))) 

; ********************************* ********************************,**** 

, , ; BDC additions to the rule base follow. . 

(defrule bdc-200-i 
■Does HALT work’ - 
(declare (salience -1000)) 

-> 

(printout t t TEST IS OVER - t) 

(halt)) 

(defrule bdc-200-2 

(declare (salience -1001)) 

— > 

(assert (fail bdc-200))) 

(deffacts bdc-201 
(bdc-201 abed e)) 

(deffacts bdc-201 -sequences 
(bdc-201 (abed e))) 

(defrule bdc-20i-l 
(bdc-201 $?data) 

(bdc-201 ($?data) ) .matches a b c d e f g 

=> 

(if (not (members b 9 data)) 

then (assert (fail bdc-201a))) 

(if (nemberS z ?data) 

then (assert (fail bdc-201b)))) 
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